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# 104 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247# 119 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253# 171 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255# 182 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259# 204 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263# 225 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265# 236 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267# 246 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269# 252 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271# 258 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273# 264 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275# 270 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277# 272 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
278# 273 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279! New line at end of file is required for FYPP
280# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
281
282# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
283
284! Caution:
285! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
286! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
287! For an example see misc/nvidia_uvm/bind.sh.
288# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
291
292# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
293
294# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
295
296# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299
300# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
301
302# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303! New line at end of file is required for FYPP
304# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
305# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
306# 14 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
307
308# 89 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
309
310# 101 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
311
312# 131 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
313# 10 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
314
315module m_riemann_solvers
316
317 use m_derived_types !< definitions of the derived types
318
319 use m_global_parameters !< definitions of the global parameters
320
321 use m_mpi_proxy !< message passing interface (mpi) module proxy
322
323 use m_variables_conversion !< state variables type conversion procedures
324
325 use m_bubbles !< to get the bubble wall pressure function
326
327 use m_bubbles_ee
328
329 use m_surface_tension !< to get the capillary fluxes
330
331 use m_helper_basic !< functions to compare floating point numbers
332
333 use m_chemistry
334
335 use m_thermochem, only: &
336 gas_constant, get_mixture_molecular_weight, &
337 get_mixture_specific_heat_cv_mass, get_mixture_energy_mass, &
338 get_species_specific_heats_r, get_species_enthalpies_rt, &
339 get_mixture_specific_heat_cp_mass
340
341# 40 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
342
343 implicit none
344
345 private; public :: s_initialize_riemann_solvers_module, &
346 s_riemann_solver, &
347 s_hll_riemann_solver, &
348 s_hllc_riemann_solver, &
349 s_hlld_riemann_solver, &
350 s_lf_riemann_solver, &
351 s_finalize_riemann_solvers_module
352
353 !> The cell-boundary values of the fluxes (src - source) that are computed
354 !! through the chosen Riemann problem solver, and the direct evaluation of
355 !! source terms, by using the left and right states given in qK_prim_rs_vf,
356 !! dqK_prim_ds_vf where ds = dx, dy or dz.
357 !> @{
358
359 real(wp), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf
360 real(wp), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf
361 real(wp), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf
362
363# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
364#if defined(MFC_OpenACC)
365# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
366!$acc declare create(flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf)
367# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
368#elif defined(MFC_OpenMP)
369# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
370!$omp declare target (flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf)
371# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
372#endif
373 !> @}
374
375 !> The cell-boundary values of the geometrical source flux that are computed
376 !! through the chosen Riemann problem solver by using the left and right
377 !! states given in qK_prim_rs_vf. Currently 2D axisymmetric for inviscid only.
378 !> @{
379
380 real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsx_vf !<
381 real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsy_vf !<
382 real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsz_vf !<
383
384# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
385#if defined(MFC_OpenACC)
386# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
387!$acc declare create(flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf)
388# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
389#elif defined(MFC_OpenMP)
390# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
391!$omp declare target (flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf)
392# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
393#endif
394 !> @}
395
396 ! The cell-boundary values of the velocity. vel_src_rs_vf is determined as
397 ! part of Riemann problem solution and is used to evaluate the source flux.
398
399 real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsx_vf
400 real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsy_vf
401 real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsz_vf
402
403# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
404#if defined(MFC_OpenACC)
405# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
406!$acc declare create(vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf)
407# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
408#elif defined(MFC_OpenMP)
409# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
410!$omp declare target (vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf)
411# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
412#endif
413
414 real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsx_vf
415 real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsy_vf
416 real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsz_vf
417
418# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
419#if defined(MFC_OpenACC)
420# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
421!$acc declare create(mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf)
422# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
423#elif defined(MFC_OpenMP)
424# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
425!$omp declare target (mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf)
426# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
427#endif
428
429 real(wp), allocatable, dimension(:, :, :, :) :: re_avg_rsx_vf
430 real(wp), allocatable, dimension(:, :, :, :) :: re_avg_rsy_vf
431 real(wp), allocatable, dimension(:, :, :, :) :: re_avg_rsz_vf
432
433# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
434#if defined(MFC_OpenACC)
435# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
436!$acc declare create(Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf)
437# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
438#elif defined(MFC_OpenMP)
439# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
440!$omp declare target (Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf)
441# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
442#endif
443
444 !> @name Indical bounds in the s1-, s2- and s3-directions
445 !> @{
446 type(int_bounds_info) :: is1, is2, is3
447 type(int_bounds_info) :: isx, isy, isz
448 !> @}
449
450
451# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
452#if defined(MFC_OpenACC)
453# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
454!$acc declare create(is1, is2, is3, isx, isy, isz)
455# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
456#elif defined(MFC_OpenMP)
457# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
458!$omp declare target (is1, is2, is3, isx, isy, isz)
459# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
460#endif
461
462 real(wp), allocatable, dimension(:) :: gs_rs
463
464# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
465#if defined(MFC_OpenACC)
466# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
467!$acc declare create(Gs_rs)
468# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
469#elif defined(MFC_OpenMP)
470# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
471!$omp declare target (Gs_rs)
472# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
473#endif
474
475 real(wp), allocatable, dimension(:, :) :: res_gs
476
477# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
478#if defined(MFC_OpenACC)
479# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
480!$acc declare create(Res_gs)
481# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
482#elif defined(MFC_OpenMP)
483# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
484!$omp declare target (Res_gs)
485# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
486#endif
487
488contains
489
490 !> Dispatch to the subroutines that are utilized to compute the
491 !! Riemann problem solution. For additional information please reference:
492 !! 1) s_hll_riemann_solver
493 !! 2) s_hllc_riemann_solver
494 !! 3) s_exact_riemann_solver
495 !! 4) s_hlld_riemann_solver
496 !! @param qL_prim_rsx_vf Left WENO-reconstructed cell-boundary values (x-dir)
497 !! @param qL_prim_rsy_vf Left WENO-reconstructed cell-boundary values (y-dir)
498 !! @param qL_prim_rsz_vf Left WENO-reconstructed cell-boundary values (z-dir)
499 !! @param dqL_prim_dx_vf The left WENO-reconstructed cell-boundary values of the
500 !! first-order x-dir spatial derivatives
501 !! @param dqL_prim_dy_vf The left WENO-reconstructed cell-boundary values of the
502 !! first-order y-dir spatial derivatives
503 !! @param dqL_prim_dz_vf The left WENO-reconstructed cell-boundary values of the
504 !! first-order z-dir spatial derivatives
505 !! @param qL_prim_vf The left WENO-reconstructed cell-boundary values of the
506 !! cell-average primitive variables
507 !! @param qR_prim_rsx_vf Right WENO-reconstructed cell-boundary values (x-dir)
508 !! @param qR_prim_rsy_vf Right WENO-reconstructed cell-boundary values (y-dir)
509 !! @param qR_prim_rsz_vf Right WENO-reconstructed cell-boundary values (z-dir)
510 !! @param dqR_prim_dx_vf The right WENO-reconstructed cell-boundary values of the
511 !! first-order x-dir spatial derivatives
512 !! @param dqR_prim_dy_vf The right WENO-reconstructed cell-boundary values of the
513 !! first-order y-dir spatial derivatives
514 !! @param dqR_prim_dz_vf The right WENO-reconstructed cell-boundary values of the
515 !! first-order z-dir spatial derivatives
516 !! @param qR_prim_vf The right WENO-reconstructed cell-boundary values of the
517 !! cell-average primitive variables
518 !! @param q_prim_vf Cell-averaged primitive variables
519 !! @param flux_vf Intra-cell fluxes
520 !! @param flux_src_vf Intra-cell fluxes sources
521 !! @param flux_gsrc_vf Intra-cell geometric fluxes sources
522 !! @param norm_dir Dir. splitting direction
523 !! @param ix Index bounds in the x-dir
524 !! @param iy Index bounds in the y-dir
525 !! @param iz Index bounds in the z-dir
526 subroutine s_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
527 dqL_prim_dy_vf, &
528 dqL_prim_dz_vf, &
529 qL_prim_vf, &
530 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
531 dqR_prim_dy_vf, &
532 dqR_prim_dz_vf, &
533 qR_prim_vf, &
534 q_prim_vf, &
535 flux_vf, flux_src_vf, &
536 flux_gsrc_vf, &
537 norm_dir, ix, iy, iz)
538
539 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
540 type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf
541
542 type(scalar_field), allocatable, dimension(:), intent(INOUT) :: ql_prim_vf, qr_prim_vf
543
544 type(scalar_field), &
545 allocatable, dimension(:), &
546 intent(INOUT) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
547 dql_prim_dy_vf, dqr_prim_dy_vf, &
548 dql_prim_dz_vf, dqr_prim_dz_vf
549
550 type(scalar_field), &
551 dimension(sys_size), &
552 intent(INOUT) :: flux_vf, flux_src_vf, flux_gsrc_vf
553
554 integer, intent(IN) :: norm_dir
555
556 type(int_bounds_info), intent(IN) :: ix, iy, iz
557
558# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
559 if (riemann_solver == 1) then
560 call s_hll_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
561 dql_prim_dy_vf, &
562 dql_prim_dz_vf, &
563 ql_prim_vf, &
564 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
565 dqr_prim_dy_vf, &
566 dqr_prim_dz_vf, &
567 qr_prim_vf, &
568 q_prim_vf, &
569 flux_vf, flux_src_vf, &
570 flux_gsrc_vf, &
571 norm_dir, ix, iy, iz)
572 end if
573# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
574 if (riemann_solver == 2) then
575 call s_hllc_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
576 dql_prim_dy_vf, &
577 dql_prim_dz_vf, &
578 ql_prim_vf, &
579 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
580 dqr_prim_dy_vf, &
581 dqr_prim_dz_vf, &
582 qr_prim_vf, &
583 q_prim_vf, &
584 flux_vf, flux_src_vf, &
585 flux_gsrc_vf, &
586 norm_dir, ix, iy, iz)
587 end if
588# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
589 if (riemann_solver == 4) then
590 call s_hlld_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
591 dql_prim_dy_vf, &
592 dql_prim_dz_vf, &
593 ql_prim_vf, &
594 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
595 dqr_prim_dy_vf, &
596 dqr_prim_dz_vf, &
597 qr_prim_vf, &
598 q_prim_vf, &
599 flux_vf, flux_src_vf, &
600 flux_gsrc_vf, &
601 norm_dir, ix, iy, iz)
602 end if
603# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
604 if (riemann_solver == 5) then
605 call s_lf_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
606 dql_prim_dy_vf, &
607 dql_prim_dz_vf, &
608 ql_prim_vf, &
609 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
610 dqr_prim_dy_vf, &
611 dqr_prim_dz_vf, &
612 qr_prim_vf, &
613 q_prim_vf, &
614 flux_vf, flux_src_vf, &
615 flux_gsrc_vf, &
616 norm_dir, ix, iy, iz)
617 end if
618# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
619
620 end subroutine s_riemann_solver
621
622 !> Dispatch to the subroutines that are utilized to compute
623 !! the viscous source fluxes for either Cartesian or cylindrical geometries.
624 !! For more information please refer to:
625 !! 1) s_compute_cartesian_viscous_source_flux
626 !! 2) s_compute_cylindrical_viscous_source_flux
627 subroutine s_compute_viscous_source_flux(velL_vf, &
628 dvelL_dx_vf, &
629 dvelL_dy_vf, &
630 dvelL_dz_vf, &
631 velR_vf, &
632 dvelR_dx_vf, &
633 dvelR_dy_vf, &
634 dvelR_dz_vf, &
635 flux_src_vf, &
636 norm_dir, &
637 ix, iy, iz)
638
639 type(scalar_field), &
640 dimension(num_vels), &
641 intent(IN) :: velL_vf, velR_vf, &
642 dvelL_dx_vf, dvelR_dx_vf, &
643 dvelL_dy_vf, dvelR_dy_vf, &
644 dvelL_dz_vf, dvelR_dz_vf
645
646 type(scalar_field), &
647 dimension(sys_size), &
648 intent(INOUT) :: flux_src_vf
649
650 integer, intent(IN) :: norm_dir
651
652 type(int_bounds_info), intent(IN) :: ix, iy, iz
653
654 if (grid_geometry == 3) then
655 call s_compute_cylindrical_viscous_source_flux(vell_vf, &
656 dvell_dx_vf, &
657 dvell_dy_vf, &
658 dvell_dz_vf, &
659 velr_vf, &
660 dvelr_dx_vf, &
661 dvelr_dy_vf, &
662 dvelr_dz_vf, &
663 flux_src_vf, &
664 norm_dir, &
665 ix, iy, iz)
666 else
667 call s_compute_cartesian_viscous_source_flux(dvell_dx_vf, &
668 dvell_dy_vf, &
669 dvell_dz_vf, &
670 dvelr_dx_vf, &
671 dvelr_dy_vf, &
672 dvelr_dz_vf, &
673 flux_src_vf, &
674 norm_dir)
675 end if
676 end subroutine s_compute_viscous_source_flux
677
678 !> @brief Computes intercell fluxes using the Harten-Lax-van Leer (HLL) approximate Riemann solver.
679 subroutine s_hll_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
680 dqL_prim_dy_vf, &
681 dqL_prim_dz_vf, &
682 qL_prim_vf, &
683 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
684 dqR_prim_dy_vf, &
685 dqR_prim_dz_vf, &
686 qR_prim_vf, &
687 q_prim_vf, &
688 flux_vf, flux_src_vf, &
689 flux_gsrc_vf, &
690 norm_dir, ix, iy, iz)
691
692 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
693 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
694
695 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
696
697 type(scalar_field), &
698 allocatable, dimension(:), &
699 intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
700 dql_prim_dy_vf, dqr_prim_dy_vf, &
701 dql_prim_dz_vf, dqr_prim_dz_vf
702
703 ! Intercell fluxes
704 type(scalar_field), &
705 dimension(sys_size), &
706 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
707 real(wp) :: flux_tau_l, flux_tau_r
708
709 integer, intent(in) :: norm_dir
710 type(int_bounds_info), intent(in) :: ix, iy, iz
711# 292 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
712 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
713 real(wp), dimension(num_vels) :: vel_l, vel_r
714 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
715 real(wp), dimension(num_species) :: ys_l, ys_r
716 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
717 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
718# 299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
719 real(wp) :: rho_l, rho_r
720 real(wp) :: pres_l, pres_r
721 real(wp) :: e_l, e_r
722 real(wp) :: h_l, h_r
723 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
724 real(wp) :: t_l, t_r
725 real(wp) :: y_l, y_r
726 real(wp) :: mw_l, mw_r
727 real(wp) :: r_gas_l, r_gas_r
728 real(wp) :: cp_l, cp_r
729 real(wp) :: cv_l, cv_r
730 real(wp) :: gamm_l, gamm_r
731 real(wp) :: gamma_l, gamma_r
732 real(wp) :: pi_inf_l, pi_inf_r
733 real(wp) :: qv_l, qv_r
734 real(wp) :: c_l, c_r
735 real(wp), dimension(6) :: tau_e_l, tau_e_r
736 real(wp) :: g_l, g_r
737 real(wp), dimension(2) :: re_l, re_r
738 real(wp), dimension(3) :: xi_field_l, xi_field_r
739
740 real(wp) :: rho_avg
741 real(wp) :: h_avg
742 real(wp) :: qv_avg
743 real(wp) :: gamma_avg
744 real(wp) :: c_avg
745
746 real(wp) :: s_l, s_r, s_m, s_p, s_s
747 real(wp) :: xi_m, xi_p
748
749 real(wp) :: ptilde_l, ptilde_r
750 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
751 real(wp) :: vel_l_tmp, vel_r_tmp
752 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
753 real(wp) :: alpha_l_sum, alpha_r_sum
754 real(wp) :: zcoef, pcorr !< low Mach number correction
755
756 type(riemann_states) :: c_fast, pres_mag
757 type(riemann_states_vec3) :: b
758
759 type(riemann_states) :: ga ! Gamma (Lorentz factor)
760 type(riemann_states) :: vdotb, b2
761 type(riemann_states_vec3) :: b4 ! 4-magnetic field components (spatial: b4x, b4y, b4z)
762 type(riemann_states_vec3) :: cm ! Conservative momentum variables
763
764 integer :: i, j, k, l, q !< Generic loop iterators
765
766 ! Populating the buffers of the left and right Riemann problem
767 ! states variables, based on the choice of boundary conditions
768 call s_populate_riemann_states_variables_buffers( &
769 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
770 dql_prim_dy_vf, &
771 dql_prim_dz_vf, &
772 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
773 dqr_prim_dy_vf, &
774 dqr_prim_dz_vf, &
775 norm_dir, ix, iy, iz)
776
777 ! Reshaping inputted data based on dimensional splitting direction
778 call s_initialize_riemann_solver( &
779 flux_src_vf, &
780 norm_dir)
781# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
782
783 if (norm_dir == 1) then
784
785# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
786
787# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
788#if defined(MFC_OpenACC)
789# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
790!$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)
791# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
792#elif defined(MFC_OpenMP)
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
799# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
800!$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)
801# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
802#endif
803# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
804
805 do l = is3%beg, is3%end
806 do k = is2%beg, is2%end
807 do j = is1%beg, is1%end
808
809# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
810#if defined(MFC_OpenACC)
811# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
812!$acc loop seq
813# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
814#elif defined(MFC_OpenMP)
815# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
816
817# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
818#endif
819 do i = 1, contxe
820 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
821 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
822 end do
823
824 vel_l_rms = 0._wp; vel_r_rms = 0._wp
825
826
827# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
828#if defined(MFC_OpenACC)
829# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
830!$acc loop seq
831# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
832#elif defined(MFC_OpenMP)
833# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
834
835# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
836#endif
837 do i = 1, num_vels
838 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
839 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
840 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
841 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
842 end do
843
844
845# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
846#if defined(MFC_OpenACC)
847# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
848!$acc loop seq
849# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
850#elif defined(MFC_OpenMP)
851# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
852
853# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
854#endif
855 do i = 1, num_fluids
856 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
857 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
858 end do
859
860 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
861 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
862
863 if (mhd) then
864 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
865 b%L(1) = bx0
866 b%R(1) = bx0
867 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
868 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
869 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
870 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
871 else ! 2D/3D: Bx, By, Bz as variables
872 b%L(1) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
873 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
874 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
875 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
876 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 2)
877 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 2)
878 end if
879 end if
880
881 rho_l = 0._wp
882 gamma_l = 0._wp
883 pi_inf_l = 0._wp
884 qv_l = 0._wp
885
886 rho_r = 0._wp
887 gamma_r = 0._wp
888 pi_inf_r = 0._wp
889 qv_r = 0._wp
890
891 alpha_l_sum = 0._wp
892 alpha_r_sum = 0._wp
893
894 pres_mag%L = 0._wp
895 pres_mag%R = 0._wp
896
897 if (mpp_lim) then
898
899# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
900#if defined(MFC_OpenACC)
901# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
902!$acc loop seq
903# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
904#elif defined(MFC_OpenMP)
905# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
906
907# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
908#endif
909 do i = 1, num_fluids
910 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
911 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
912 alpha_l_sum = alpha_l_sum + alpha_l(i)
913 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
914 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
915 alpha_r_sum = alpha_r_sum + alpha_r(i)
916 end do
917
918 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
919 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
920 end if
921
922
923# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
924#if defined(MFC_OpenACC)
925# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
926!$acc loop seq
927# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
928#elif defined(MFC_OpenMP)
929# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
930
931# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
932#endif
933 do i = 1, num_fluids
934 rho_l = rho_l + alpha_rho_l(i)
935 gamma_l = gamma_l + alpha_l(i)*gammas(i)
936 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
937 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
938
939 rho_r = rho_r + alpha_rho_r(i)
940 gamma_r = gamma_r + alpha_r(i)*gammas(i)
941 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
942 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
943 end do
944
945 if (viscous) then
946
947# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
948#if defined(MFC_OpenACC)
949# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
950!$acc loop seq
951# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
952#elif defined(MFC_OpenMP)
953# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
954
955# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
956#endif
957 do i = 1, 2
958 re_l(i) = dflt_real
959 re_r(i) = dflt_real
960
961 if (re_size(i) > 0) re_l(i) = 0._wp
962 if (re_size(i) > 0) re_r(i) = 0._wp
963
964
965# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
966#if defined(MFC_OpenACC)
967# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
968!$acc loop seq
969# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
970#elif defined(MFC_OpenMP)
971# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
972
973# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
974#endif
975 do q = 1, re_size(i)
976 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
977 + re_l(i)
978 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
979 + re_r(i)
980 end do
981
982 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
983 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
984 end do
985 end if
986
987 if (chemistry) then
988
989# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
990#if defined(MFC_OpenACC)
991# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
992!$acc loop seq
993# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
994#elif defined(MFC_OpenMP)
995# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
996
997# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
998#endif
999 do i = chemxb, chemxe
1000 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
1001 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
1002 end do
1003
1004 call get_mixture_molecular_weight(ys_l, mw_l)
1005 call get_mixture_molecular_weight(ys_r, mw_r)
1006# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1007 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1008 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1009# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1010
1011 r_gas_l = gas_constant/mw_l
1012 r_gas_r = gas_constant/mw_r
1013 t_l = pres_l/rho_l/r_gas_l
1014 t_r = pres_r/rho_r/r_gas_r
1015
1016 call get_species_specific_heats_r(t_l, cp_il)
1017 call get_species_specific_heats_r(t_r, cp_ir)
1018
1019 if (chem_params%gamma_method == 1) then
1020 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1021 gamma_il = cp_il/(cp_il - 1.0_wp)
1022 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
1023
1024 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
1025 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
1026 else if (chem_params%gamma_method == 2) then
1027 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1028 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1029 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1030 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1031 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1032
1033 gamm_l = cp_l/cv_l
1034 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
1035 gamm_r = cp_r/cv_r
1036 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1037 end if
1038
1039 call get_mixture_energy_mass(t_l, ys_l, e_l)
1040 call get_mixture_energy_mass(t_r, ys_r, e_r)
1041
1042 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1043 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1044 h_l = (e_l + pres_l)/rho_l
1045 h_r = (e_r + pres_r)/rho_r
1046 elseif (mhd .and. relativity) then
1047 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
1048 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
1049# 533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1050 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
1051 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
1052
1053 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
1054 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
1055 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
1056 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
1057# 541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1058
1059 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
1060 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
1061
1062 ! Hard-coded EOS
1063 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
1064 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
1065# 549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1066 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
1067 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
1068# 552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1069
1070 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
1071 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
1072 elseif (mhd .and. .not. relativity) then
1073# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1074 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
1075 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
1076# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1077 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
1078 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
1079 h_l = (e_l + pres_l - pres_mag%L)/rho_l
1080 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
1081 else
1082 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
1083 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
1084 h_l = (e_l + pres_l)/rho_l
1085 h_r = (e_r + pres_r)/rho_r
1086 end if
1087
1088 ! elastic energy update
1089 if (hypoelasticity) then
1090 g_l = 0._wp; g_r = 0._wp
1091
1092
1093# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1094#if defined(MFC_OpenACC)
1095# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1096!$acc loop seq
1097# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1098#elif defined(MFC_OpenMP)
1099# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1100
1101# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1102#endif
1103 do i = 1, num_fluids
1104 g_l = g_l + alpha_l(i)*gs_rs(i)
1105 g_r = g_r + alpha_r(i)*gs_rs(i)
1106 end do
1107
1108 if (cont_damage) then
1109 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
1110 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
1111 end if
1112
1113
1114# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1115#if defined(MFC_OpenACC)
1116# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1117!$acc loop seq
1118# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1119#elif defined(MFC_OpenMP)
1120# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1121
1122# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1123#endif
1124 do i = 1, strxe - strxb + 1
1125 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
1126 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
1127 ! Elastic contribution to energy if G large enough
1128 !TODO take out if statement if stable without
1129 if ((g_l > 1000) .and. (g_r > 1000)) then
1130 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1131 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1132 ! Double for shear stresses
1133 if (any(strxb - 1 + i == shear_indices)) then
1134 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1135 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1136 end if
1137 end if
1138 end do
1139 end if
1140
1141 ! elastic energy update
1142 !if ( hyperelasticity ) then
1143 ! G_L = 0._wp
1144 ! G_R = 0._wp
1145 !
1146 ! $:GPU_LOOP(parallelism='[seq]')
1147 ! do i = 1, num_fluids
1148 ! G_L = G_L + alpha_L(i)*Gs_rs(i)
1149 ! G_R = G_R + alpha_R(i)*Gs_rs(i)
1150 ! end do
1151 ! ! Elastic contribution to energy if G large enough
1152 ! if ((G_L > 1.e-3_wp) .and. (G_R > 1.e-3_wp)) then
1153 ! E_L = E_L + G_L*qL_prim_rsx_vf(j, k, l, xiend + 1)
1154 ! E_R = E_R + G_R*qR_prim_rsx_vf(j + 1, k, l, xiend + 1)
1155 ! $:GPU_LOOP(parallelism='[seq]')
1156 ! do i = 1, b_size-1
1157 ! tau_e_L(i) = G_L*qL_prim_rsx_vf(j, k, l, strxb - 1 + i)
1158 ! tau_e_R(i) = G_R*qR_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
1159 ! end do
1160 ! $:GPU_LOOP(parallelism='[seq]')
1161 ! do i = 1, b_size-1
1162 ! tau_e_L(i) = 0._wp
1163 ! tau_e_R(i) = 0._wp
1164 ! end do
1165 ! $:GPU_LOOP(parallelism='[seq]')
1166 ! do i = 1, num_dims
1167 ! xi_field_L(i) = qL_prim_rsx_vf(j, k, l, xibeg - 1 + i)
1168 ! xi_field_R(i) = qR_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
1169 ! end do
1170 ! end if
1171 !end if
1172
1173
1174# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1175 if (avg_state == 1) then
1176# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1177
1178# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1179 rho_avg = sqrt(rho_l*rho_r)
1180# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1181
1182# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1183 vel_avg_rms = 0._wp
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
1188# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1189#if defined(MFC_OpenACC)
1190# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1191!$acc loop seq
1192# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1193#elif defined(MFC_OpenMP)
1194# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1195
1196# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1197#endif
1198# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1199 do i = 1, num_vels
1200# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1201 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
1202# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1203 (sqrt(rho_l) + sqrt(rho_r))**2._wp
1204# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1205 end do
1206# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1207
1208# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1209 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
1210# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1211 (sqrt(rho_l) + sqrt(rho_r))
1212# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1213
1214# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1215 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
1216# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1217 (sqrt(rho_l) + sqrt(rho_r))
1218# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1219
1220# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1221 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
1222# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1223 (sqrt(rho_l) + sqrt(rho_r))**2._wp
1224# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1225
1226# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1227 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
1228# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1229 (sqrt(rho_l) + sqrt(rho_r))
1230# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1231
1232# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1233 if (chemistry) then
1234# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1235 eps = 0.001_wp
1236# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1237 call get_species_enthalpies_rt(t_l, h_il)
1238# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1239 call get_species_enthalpies_rt(t_r, h_ir)
1240# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1241 h_il = h_il*gas_constant/molecular_weights*t_l
1242# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1243 h_ir = h_ir*gas_constant/molecular_weights*t_r
1244# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1245 call get_species_specific_heats_r(t_l, cp_il)
1246# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1247 call get_species_specific_heats_r(t_r, cp_ir)
1248# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1249
1250# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1251 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1252# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1253 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1254# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1255 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1256# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1257 if (abs(t_l - t_r) < eps) then
1258# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1259 ! Case when T_L and T_R are very close
1260# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1261 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1262# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1263 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
1264# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1265 else
1266# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1267 ! Normal calculation when T_L and T_R are sufficiently different
1268# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1269 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1270# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1271 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1272# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1273 end if
1274# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1275 gamma_avg = cp_avg/cv_avg
1276# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1277
1278# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1279 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1280# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1281 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1282# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1283
1284# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1285 end if
1286# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1287
1288# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1289 end if
1290# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1291
1292# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1293 if (avg_state == 2) then
1294# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1295 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1296# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1297 vel_avg_rms = 0._wp
1298# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1299
1300# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1301#if defined(MFC_OpenACC)
1302# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1303!$acc loop seq
1304# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1305#elif defined(MFC_OpenMP)
1306# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1307
1308# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1309#endif
1310# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1311 do i = 1, num_vels
1312# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1313 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1314# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1315 end do
1316# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1317
1318# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1319 h_avg = 5.e-1_wp*(h_l + h_r)
1320# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1321 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1322# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1323 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1324# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1325
1326# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1327 end if
1328# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1329
1330
1331 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
1332 vel_l_rms, 0._wp, c_l, qv_l)
1333
1334 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
1335 vel_r_rms, 0._wp, c_r, qv_r)
1336
1337 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1338 ! variables are placeholders to call the subroutine.
1339
1340 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
1341 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
1342
1343 if (mhd) then
1344 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
1345 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
1346 end if
1347
1348 if (hyper_cleaning) then ! mhd
1349 c_fast%L = min(c_fast%L, -hyper_cleaning_speed)
1350 c_fast%R = max(c_fast%R, hyper_cleaning_speed)
1351 end if
1352
1353 if (viscous) then
1354 if (chemistry) then
1355 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1356 end if
1357
1358# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1359#if defined(MFC_OpenACC)
1360# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1361!$acc loop seq
1362# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1363#elif defined(MFC_OpenMP)
1364# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1365
1366# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1367#endif
1368 do i = 1, 2
1369 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1370 end do
1371 end if
1372
1373 if (wave_speeds == 1) then
1374 if (mhd) then
1375 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
1376 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
1377 elseif (hypoelasticity) then
1378 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
1379 (((4._wp*g_l)/3._wp) + &
1380 tau_e_l(dir_idx_tau(1)))/rho_l) &
1381 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
1382 (((4._wp*g_r)/3._wp) + &
1383 tau_e_r(dir_idx_tau(1)))/rho_r))
1384 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
1385 (((4._wp*g_r)/3._wp) + &
1386 tau_e_r(dir_idx_tau(1)))/rho_r) &
1387 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
1388 (((4._wp*g_l)/3._wp) + &
1389 tau_e_l(dir_idx_tau(1)))/rho_l))
1390 else if (hyperelasticity) then
1391 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l) &
1392 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
1393 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r) &
1394 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
1395 else
1396 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1397 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1398 end if
1399
1400 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
1401 (s_l - vel_l(dir_idx(1))) - &
1402 rho_r*vel_r(dir_idx(1))* &
1403 (s_r - vel_r(dir_idx(1)))) &
1404 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
1405 rho_r*(s_r - vel_r(dir_idx(1))))
1406 elseif (wave_speeds == 2) then
1407 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
1408 (vel_l(dir_idx(1)) - &
1409 vel_r(dir_idx(1))))
1410
1411 pres_sr = pres_sl
1412
1413 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
1414 (pres_sl/pres_l - 1._wp)*pres_l/ &
1415 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1416 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
1417 (pres_sr/pres_r - 1._wp)*pres_r/ &
1418 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1419
1420 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1421 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1422
1423 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
1424 (pres_l - pres_r)/ &
1425 (rho_avg*c_avg))
1426 end if
1427
1428 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1429
1430 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) &
1431 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
1432 *(5.e-1_wp + sign(5.e-1_wp, s_r))
1433 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) &
1434 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
1435 *(5.e-1_wp + sign(5.e-1_wp, s_r))
1436
1437 ! Low Mach correction
1438 if (low_mach == 1) then
1439
1440# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1441 if (riemann_solver == 1 .or. riemann_solver == 5) then
1442# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1443
1444# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1445 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1446# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1447 pcorr = 0._wp
1448# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1449
1450# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1451 if (low_mach == 1) then
1452# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1453 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1454# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1455 end if
1456# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1457
1458# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1459 else if (riemann_solver == 2) then
1460# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1461 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1462# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1463 pcorr = 0._wp
1464# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1465
1466# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1467 if (low_mach == 1) then
1468# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1469 pcorr = rho_l*rho_r* &
1470# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1471 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
1472# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1473 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
1474# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1475 (zcoef - 1._wp)
1476# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1477 else if (low_mach == 2) then
1478# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1479 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))))
1480# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1481 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))))
1482# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1483 vel_l(dir_idx(1)) = vel_l_tmp
1484# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1485 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
1490# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1491
1492 else
1493 pcorr = 0._wp
1494 end if
1495
1496 ! Mass
1497 if (.not. relativity) then
1498
1499# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1500#if defined(MFC_OpenACC)
1501# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1502!$acc loop seq
1503# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1504#elif defined(MFC_OpenMP)
1505# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1506
1507# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1508#endif
1509 do i = 1, contxe
1510 flux_rsx_vf(j, k, l, i) = &
1511 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
1512 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
1513 + s_m*s_p*(alpha_rho_l(i) &
1514 - alpha_rho_r(i))) &
1515 /(s_m - s_p)
1516 end do
1517 elseif (relativity) then
1518
1519# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1520#if defined(MFC_OpenACC)
1521# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1522!$acc loop seq
1523# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1524#elif defined(MFC_OpenMP)
1525# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1526
1527# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1528#endif
1529 do i = 1, contxe
1530 flux_rsx_vf(j, k, l, i) = &
1531 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
1532 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
1533 + s_m*s_p*(ga%L*alpha_rho_l(i) &
1534 - ga%R*alpha_rho_r(i))) &
1535 /(s_m - s_p)
1536 end do
1537 end if
1538
1539 ! Momentum
1540 if (mhd .and. (.not. relativity)) then
1541
1542# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1543#if defined(MFC_OpenACC)
1544# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1545!$acc loop seq
1546# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1547#elif defined(MFC_OpenMP)
1548# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1549
1550# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1551#endif
1552 do i = 1, 3
1553 ! Flux of rho*v_i in the x direction
1554 ! = rho * v_i * v_x - B_i * B_x + delta_(x,i) * p_tot
1555 flux_rsx_vf(j, k, l, contxe + i) = &
1556 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
1557 - b%R(i)*b%R(norm_dir) &
1558 + dir_flg(i)*(pres_r + pres_mag%R)) &
1559 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
1560 - b%L(i)*b%L(norm_dir) &
1561 + dir_flg(i)*(pres_l + pres_mag%L)) &
1562 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
1563 /(s_m - s_p)
1564 end do
1565 elseif (mhd .and. relativity) then
1566
1567# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1568#if defined(MFC_OpenACC)
1569# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1570!$acc loop seq
1571# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1572#elif defined(MFC_OpenMP)
1573# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1574
1575# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1576#endif
1577 do i = 1, 3
1578 ! Flux of m_i in the x direction
1579 ! = m_i * v_x - b_i/Gamma * B_x + delta_(x,i) * p_tot
1580 flux_rsx_vf(j, k, l, contxe + i) = &
1581 (s_m*(cm%R(i)*vel_r(norm_dir) &
1582 - b4%R(i)/ga%R*b%R(norm_dir) &
1583 + dir_flg(i)*(pres_r + pres_mag%R)) &
1584 - s_p*(cm%L(i)*vel_l(norm_dir) &
1585 - b4%L(i)/ga%L*b%L(norm_dir) &
1586 + dir_flg(i)*(pres_l + pres_mag%L)) &
1587 + s_m*s_p*(cm%L(i) - cm%R(i))) &
1588 /(s_m - s_p)
1589 end do
1590 elseif (bubbles_euler) then
1591
1592# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1593#if defined(MFC_OpenACC)
1594# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1595!$acc loop seq
1596# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1597#elif defined(MFC_OpenMP)
1598# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1599
1600# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1601#endif
1602 do i = 1, num_vels
1603 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
1604 (s_m*(rho_r*vel_r(dir_idx(1)) &
1605 *vel_r(dir_idx(i)) &
1606 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
1607 - s_p*(rho_l*vel_l(dir_idx(1)) &
1608 *vel_l(dir_idx(i)) &
1609 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
1610 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1611 - rho_r*vel_r(dir_idx(i)))) &
1612 /(s_m - s_p) &
1613 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1614 end do
1615 else if (hypoelasticity) then
1616
1617# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1618#if defined(MFC_OpenACC)
1619# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1620!$acc loop seq
1621# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1622#elif defined(MFC_OpenMP)
1623# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1624
1625# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1626#endif
1627 do i = 1, num_vels
1628 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
1629 (s_m*(rho_r*vel_r(dir_idx(1)) &
1630 *vel_r(dir_idx(i)) &
1631 + dir_flg(dir_idx(i))*pres_r &
1632 - tau_e_r(dir_idx_tau(i))) &
1633 - s_p*(rho_l*vel_l(dir_idx(1)) &
1634 *vel_l(dir_idx(i)) &
1635 + dir_flg(dir_idx(i))*pres_l &
1636 - tau_e_l(dir_idx_tau(i))) &
1637 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1638 - rho_r*vel_r(dir_idx(i)))) &
1639 /(s_m - s_p)
1640 end do
1641 else
1642
1643# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1644#if defined(MFC_OpenACC)
1645# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1646!$acc loop seq
1647# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1648#elif defined(MFC_OpenMP)
1649# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1650
1651# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1652#endif
1653 do i = 1, num_vels
1654 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
1655 (s_m*(rho_r*vel_r(dir_idx(1)) &
1656 *vel_r(dir_idx(i)) &
1657 + dir_flg(dir_idx(i))*pres_r) &
1658 - s_p*(rho_l*vel_l(dir_idx(1)) &
1659 *vel_l(dir_idx(i)) &
1660 + dir_flg(dir_idx(i))*pres_l) &
1661 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1662 - rho_r*vel_r(dir_idx(i)))) &
1663 /(s_m - s_p) &
1664 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1665 end do
1666 end if
1667
1668 ! Energy
1669 if (mhd .and. (.not. relativity)) then
1670 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
1671# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1672 flux_rsx_vf(j, k, l, e_idx) = &
1673 (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))) &
1674 - 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))) &
1675 + s_m*s_p*(e_l - e_r)) &
1676 /(s_m - s_p)
1677# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1678 elseif (mhd .and. relativity) then
1679 ! energy flux = m_x - mass flux
1680 ! Hard-coded for single-component for now
1681 flux_rsx_vf(j, k, l, e_idx) = &
1682 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
1683 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
1684 + s_m*s_p*(e_l - e_r)) &
1685 /(s_m - s_p)
1686 else if (bubbles_euler) then
1687 flux_rsx_vf(j, k, l, e_idx) = &
1688 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
1689 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
1690 + s_m*s_p*(e_l - e_r)) &
1691 /(s_m - s_p) &
1692 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
1693 else if (hypoelasticity) then
1694 flux_tau_l = 0._wp; flux_tau_r = 0._wp
1695
1696# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1697#if defined(MFC_OpenACC)
1698# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1699!$acc loop seq
1700# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1701#elif defined(MFC_OpenMP)
1702# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1703
1704# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1705#endif
1706 do i = 1, num_dims
1707 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
1708 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
1709 end do
1710 flux_rsx_vf(j, k, l, e_idx) = &
1711 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
1712 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
1713 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
1714 else
1715 flux_rsx_vf(j, k, l, e_idx) = &
1716 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
1717 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
1718 + s_m*s_p*(e_l - e_r)) &
1719 /(s_m - s_p) &
1720 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
1721 end if
1722
1723 ! Elastic Stresses
1724 if (hypoelasticity) then
1725 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
1726 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
1727 (s_m*(rho_r*vel_r(dir_idx(1)) &
1728 *tau_e_r(i)) &
1729 - s_p*(rho_l*vel_l(dir_idx(1)) &
1730 *tau_e_l(i)) &
1731 + s_m*s_p*(rho_l*tau_e_l(i) &
1732 - rho_r*tau_e_r(i))) &
1733 /(s_m - s_p)
1734 end do
1735 end if
1736
1737 ! Advection
1738
1739# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1740#if defined(MFC_OpenACC)
1741# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1742!$acc loop seq
1743# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1744#elif defined(MFC_OpenMP)
1745# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1746
1747# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1748#endif
1749 do i = advxb, advxe
1750 flux_rsx_vf(j, k, l, i) = &
1751 (ql_prim_rsx_vf(j, k, l, i) &
1752 - qr_prim_rsx_vf(j + 1, k, l, i)) &
1753 *s_m*s_p/(s_m - s_p)
1754 flux_src_rsx_vf(j, k, l, i) = &
1755 (s_m*qr_prim_rsx_vf(j + 1, k, l, i) &
1756 - s_p*ql_prim_rsx_vf(j, k, l, i)) &
1757 /(s_m - s_p)
1758 end do
1759
1760 if (bubbles_euler) then
1761 ! From HLLC: Kills mass transport @ bubble gas density
1762 if (num_fluids > 1) then
1763 flux_rsx_vf(j, k, l, contxe) = 0._wp
1764 end if
1765 end if
1766
1767 if (chemistry) then
1768
1769# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1770#if defined(MFC_OpenACC)
1771# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1772!$acc loop seq
1773# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1774#elif defined(MFC_OpenMP)
1775# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1776
1777# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1778#endif
1779 do i = chemxb, chemxe
1780 y_l = ql_prim_rsx_vf(j, k, l, i)
1781 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
1782
1783 flux_rsx_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
1784 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
1785 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
1786 /(s_m - s_p)
1787 flux_src_rsx_vf(j, k, l, i) = 0._wp
1788 end do
1789 end if
1790
1791 if (mhd) then
1792 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
1793 ! B_y flux = v_x * B_y - v_y * Bx0
1794 ! B_z flux = v_x * B_z - v_z * Bx0
1795
1796# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1797#if defined(MFC_OpenACC)
1798# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1799!$acc loop seq
1800# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1801#elif defined(MFC_OpenMP)
1802# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1803
1804# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1805#endif
1806 do i = 0, 1
1807 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
1808 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
1809 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
1810 end do
1811 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
1812 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x)
1813 ! B_y d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x)
1814 ! B_z d/dx flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
1815
1816# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1817#if defined(MFC_OpenACC)
1818# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1819!$acc loop seq
1820# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1821#elif defined(MFC_OpenMP)
1822# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1823
1824# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1825#endif
1826 do i = 0, 2
1827 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)) - &
1828 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
1829 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
1830 end do
1831
1832 if (hyper_cleaning) then
1833 ! propagate magnetic field divergence as a wave
1834 flux_rsx_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, b_idx%beg + norm_dir - 1) + &
1835 (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)
1836
1837 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)
1838 else
1839 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
1840 end if
1841 end if
1842 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
1843 end if
1844
1845# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1846
1847 end do
1848 end do
1849 end do
1850
1851# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1852
1853# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1854#if defined(MFC_OpenACC)
1855# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1856!$acc end parallel loop
1857# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1858#elif defined(MFC_OpenMP)
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
1863# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1864!$omp end target teams loop
1865# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1866#endif
1867# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1868
1869 end if
1870
1871# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1872
1873 if (norm_dir == 2) then
1874
1875# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1876
1877# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1878#if defined(MFC_OpenACC)
1879# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1880!$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)
1881# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1882#elif defined(MFC_OpenMP)
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
1889# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1890!$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)
1891# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1892#endif
1893# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1894
1895 do l = is3%beg, is3%end
1896 do k = is2%beg, is2%end
1897 do j = is1%beg, is1%end
1898
1899# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1900#if defined(MFC_OpenACC)
1901# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1902!$acc loop seq
1903# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1904#elif defined(MFC_OpenMP)
1905# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1906
1907# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1908#endif
1909 do i = 1, contxe
1910 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
1911 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
1912 end do
1913
1914 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1915
1916
1917# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1918#if defined(MFC_OpenACC)
1919# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1920!$acc loop seq
1921# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1922#elif defined(MFC_OpenMP)
1923# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1924
1925# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1926#endif
1927 do i = 1, num_vels
1928 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
1929 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
1930 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1931 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1932 end do
1933
1934
1935# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1936#if defined(MFC_OpenACC)
1937# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1938!$acc loop seq
1939# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1940#elif defined(MFC_OpenMP)
1941# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1942
1943# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1944#endif
1945 do i = 1, num_fluids
1946 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
1947 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
1948 end do
1949
1950 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
1951 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
1952
1953 if (mhd) then
1954 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
1955 b%L(1) = bx0
1956 b%R(1) = bx0
1957 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
1958 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
1959 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
1960 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
1961 else ! 2D/3D: Bx, By, Bz as variables
1962 b%L(1) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
1963 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
1964 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
1965 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
1966 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 2)
1967 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 2)
1968 end if
1969 end if
1970
1971 rho_l = 0._wp
1972 gamma_l = 0._wp
1973 pi_inf_l = 0._wp
1974 qv_l = 0._wp
1975
1976 rho_r = 0._wp
1977 gamma_r = 0._wp
1978 pi_inf_r = 0._wp
1979 qv_r = 0._wp
1980
1981 alpha_l_sum = 0._wp
1982 alpha_r_sum = 0._wp
1983
1984 pres_mag%L = 0._wp
1985 pres_mag%R = 0._wp
1986
1987 if (mpp_lim) then
1988
1989# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1990#if defined(MFC_OpenACC)
1991# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1992!$acc loop seq
1993# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1994#elif defined(MFC_OpenMP)
1995# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1996
1997# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1998#endif
1999 do i = 1, num_fluids
2000 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
2001 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2002 alpha_l_sum = alpha_l_sum + alpha_l(i)
2003 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2004 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2005 alpha_r_sum = alpha_r_sum + alpha_r(i)
2006 end do
2007
2008 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2009 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2010 end if
2011
2012
2013# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2014#if defined(MFC_OpenACC)
2015# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2016!$acc loop seq
2017# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2018#elif defined(MFC_OpenMP)
2019# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2020
2021# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2022#endif
2023 do i = 1, num_fluids
2024 rho_l = rho_l + alpha_rho_l(i)
2025 gamma_l = gamma_l + alpha_l(i)*gammas(i)
2026 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
2027 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
2028
2029 rho_r = rho_r + alpha_rho_r(i)
2030 gamma_r = gamma_r + alpha_r(i)*gammas(i)
2031 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
2032 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
2033 end do
2034
2035 if (viscous) then
2036
2037# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2038#if defined(MFC_OpenACC)
2039# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2040!$acc loop seq
2041# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2042#elif defined(MFC_OpenMP)
2043# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2044
2045# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2046#endif
2047 do i = 1, 2
2048 re_l(i) = dflt_real
2049 re_r(i) = dflt_real
2050
2051 if (re_size(i) > 0) re_l(i) = 0._wp
2052 if (re_size(i) > 0) re_r(i) = 0._wp
2053
2054
2055# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2056#if defined(MFC_OpenACC)
2057# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2058!$acc loop seq
2059# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2060#elif defined(MFC_OpenMP)
2061# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2062
2063# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2064#endif
2065 do q = 1, re_size(i)
2066 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
2067 + re_l(i)
2068 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
2069 + re_r(i)
2070 end do
2071
2072 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2073 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2074 end do
2075 end if
2076
2077 if (chemistry) then
2078
2079# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2080#if defined(MFC_OpenACC)
2081# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2082!$acc loop seq
2083# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2084#elif defined(MFC_OpenMP)
2085# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2086
2087# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2088#endif
2089 do i = chemxb, chemxe
2090 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
2091 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
2092 end do
2093
2094 call get_mixture_molecular_weight(ys_l, mw_l)
2095 call get_mixture_molecular_weight(ys_r, mw_r)
2096# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2097 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2098 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2099# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2100
2101 r_gas_l = gas_constant/mw_l
2102 r_gas_r = gas_constant/mw_r
2103 t_l = pres_l/rho_l/r_gas_l
2104 t_r = pres_r/rho_r/r_gas_r
2105
2106 call get_species_specific_heats_r(t_l, cp_il)
2107 call get_species_specific_heats_r(t_r, cp_ir)
2108
2109 if (chem_params%gamma_method == 1) then
2110 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2111 gamma_il = cp_il/(cp_il - 1.0_wp)
2112 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2113
2114 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2115 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2116 else if (chem_params%gamma_method == 2) then
2117 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2118 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2119 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2120 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2121 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2122
2123 gamm_l = cp_l/cv_l
2124 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
2125 gamm_r = cp_r/cv_r
2126 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2127 end if
2128
2129 call get_mixture_energy_mass(t_l, ys_l, e_l)
2130 call get_mixture_energy_mass(t_r, ys_r, e_r)
2131
2132 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2133 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2134 h_l = (e_l + pres_l)/rho_l
2135 h_r = (e_r + pres_r)/rho_r
2136 elseif (mhd .and. relativity) then
2137 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
2138 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
2139# 533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2140 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
2141 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
2142
2143 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
2144 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
2145 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
2146 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
2147# 541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2148
2149 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
2150 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
2151
2152 ! Hard-coded EOS
2153 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
2154 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
2155# 549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2156 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
2157 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
2158# 552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2159
2160 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
2161 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
2162 elseif (mhd .and. .not. relativity) then
2163# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2164 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
2165 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
2166# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2167 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
2168 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
2169 h_l = (e_l + pres_l - pres_mag%L)/rho_l
2170 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
2171 else
2172 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2173 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2174 h_l = (e_l + pres_l)/rho_l
2175 h_r = (e_r + pres_r)/rho_r
2176 end if
2177
2178 ! elastic energy update
2179 if (hypoelasticity) then
2180 g_l = 0._wp; g_r = 0._wp
2181
2182
2183# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2184#if defined(MFC_OpenACC)
2185# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2186!$acc loop seq
2187# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2188#elif defined(MFC_OpenMP)
2189# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2190
2191# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2192#endif
2193 do i = 1, num_fluids
2194 g_l = g_l + alpha_l(i)*gs_rs(i)
2195 g_r = g_r + alpha_r(i)*gs_rs(i)
2196 end do
2197
2198 if (cont_damage) then
2199 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
2200 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
2201 end if
2202
2203
2204# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2205#if defined(MFC_OpenACC)
2206# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2207!$acc loop seq
2208# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2209#elif defined(MFC_OpenMP)
2210# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2211
2212# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2213#endif
2214 do i = 1, strxe - strxb + 1
2215 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
2216 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
2217 ! Elastic contribution to energy if G large enough
2218 !TODO take out if statement if stable without
2219 if ((g_l > 1000) .and. (g_r > 1000)) then
2220 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2221 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2222 ! Double for shear stresses
2223 if (any(strxb - 1 + i == shear_indices)) then
2224 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2225 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2226 end if
2227 end if
2228 end do
2229 end if
2230
2231 ! elastic energy update
2232 !if ( hyperelasticity ) then
2233 ! G_L = 0._wp
2234 ! G_R = 0._wp
2235 !
2236 ! $:GPU_LOOP(parallelism='[seq]')
2237 ! do i = 1, num_fluids
2238 ! G_L = G_L + alpha_L(i)*Gs_rs(i)
2239 ! G_R = G_R + alpha_R(i)*Gs_rs(i)
2240 ! end do
2241 ! ! Elastic contribution to energy if G large enough
2242 ! if ((G_L > 1.e-3_wp) .and. (G_R > 1.e-3_wp)) then
2243 ! E_L = E_L + G_L*qL_prim_rsy_vf(j, k, l, xiend + 1)
2244 ! E_R = E_R + G_R*qR_prim_rsy_vf(j + 1, k, l, xiend + 1)
2245 ! $:GPU_LOOP(parallelism='[seq]')
2246 ! do i = 1, b_size-1
2247 ! tau_e_L(i) = G_L*qL_prim_rsy_vf(j, k, l, strxb - 1 + i)
2248 ! tau_e_R(i) = G_R*qR_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
2249 ! end do
2250 ! $:GPU_LOOP(parallelism='[seq]')
2251 ! do i = 1, b_size-1
2252 ! tau_e_L(i) = 0._wp
2253 ! tau_e_R(i) = 0._wp
2254 ! end do
2255 ! $:GPU_LOOP(parallelism='[seq]')
2256 ! do i = 1, num_dims
2257 ! xi_field_L(i) = qL_prim_rsy_vf(j, k, l, xibeg - 1 + i)
2258 ! xi_field_R(i) = qR_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
2259 ! end do
2260 ! end if
2261 !end if
2262
2263
2264# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2265 if (avg_state == 1) then
2266# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2267
2268# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2269 rho_avg = sqrt(rho_l*rho_r)
2270# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2271
2272# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2273 vel_avg_rms = 0._wp
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
2278# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2279#if defined(MFC_OpenACC)
2280# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2281!$acc loop seq
2282# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2283#elif defined(MFC_OpenMP)
2284# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2285
2286# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2287#endif
2288# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2289 do i = 1, num_vels
2290# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2291 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
2292# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2293 (sqrt(rho_l) + sqrt(rho_r))**2._wp
2294# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2295 end do
2296# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2297
2298# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2299 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
2300# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2301 (sqrt(rho_l) + sqrt(rho_r))
2302# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2303
2304# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2305 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
2306# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2307 (sqrt(rho_l) + sqrt(rho_r))
2308# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2309
2310# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2311 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
2312# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2313 (sqrt(rho_l) + sqrt(rho_r))**2._wp
2314# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2315
2316# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2317 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
2318# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2319 (sqrt(rho_l) + sqrt(rho_r))
2320# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2321
2322# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2323 if (chemistry) then
2324# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2325 eps = 0.001_wp
2326# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2327 call get_species_enthalpies_rt(t_l, h_il)
2328# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2329 call get_species_enthalpies_rt(t_r, h_ir)
2330# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2331 h_il = h_il*gas_constant/molecular_weights*t_l
2332# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2333 h_ir = h_ir*gas_constant/molecular_weights*t_r
2334# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2335 call get_species_specific_heats_r(t_l, cp_il)
2336# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2337 call get_species_specific_heats_r(t_r, cp_ir)
2338# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2339
2340# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2341 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2342# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2343 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2344# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2345 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2346# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2347 if (abs(t_l - t_r) < eps) then
2348# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2349 ! Case when T_L and T_R are very close
2350# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2351 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2352# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2353 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
2354# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2355 else
2356# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2357 ! Normal calculation when T_L and T_R are sufficiently different
2358# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2359 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2360# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2361 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2362# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2363 end if
2364# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2365 gamma_avg = cp_avg/cv_avg
2366# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2367
2368# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2369 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2370# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2371 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2372# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2373
2374# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2375 end if
2376# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2377
2378# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2379 end if
2380# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2381
2382# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2383 if (avg_state == 2) then
2384# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2385 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2386# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2387 vel_avg_rms = 0._wp
2388# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2389
2390# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2391#if defined(MFC_OpenACC)
2392# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2393!$acc loop seq
2394# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2395#elif defined(MFC_OpenMP)
2396# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2397
2398# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2399#endif
2400# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2401 do i = 1, num_vels
2402# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2403 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2404# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2405 end do
2406# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2407
2408# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2409 h_avg = 5.e-1_wp*(h_l + h_r)
2410# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2411 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2412# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2413 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2414# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2415
2416# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2417 end if
2418# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2419
2420
2421 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
2422 vel_l_rms, 0._wp, c_l, qv_l)
2423
2424 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
2425 vel_r_rms, 0._wp, c_r, qv_r)
2426
2427 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2428 ! variables are placeholders to call the subroutine.
2429
2430 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
2431 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
2432
2433 if (mhd) then
2434 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
2435 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
2436 end if
2437
2438 if (hyper_cleaning) then ! mhd
2439 c_fast%L = min(c_fast%L, -hyper_cleaning_speed)
2440 c_fast%R = max(c_fast%R, hyper_cleaning_speed)
2441 end if
2442
2443 if (viscous) then
2444 if (chemistry) then
2445 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2446 end if
2447
2448# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2449#if defined(MFC_OpenACC)
2450# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2451!$acc loop seq
2452# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2453#elif defined(MFC_OpenMP)
2454# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2455
2456# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2457#endif
2458 do i = 1, 2
2459 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2460 end do
2461 end if
2462
2463 if (wave_speeds == 1) then
2464 if (mhd) then
2465 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
2466 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
2467 elseif (hypoelasticity) then
2468 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
2469 (((4._wp*g_l)/3._wp) + &
2470 tau_e_l(dir_idx_tau(1)))/rho_l) &
2471 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
2472 (((4._wp*g_r)/3._wp) + &
2473 tau_e_r(dir_idx_tau(1)))/rho_r))
2474 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
2475 (((4._wp*g_r)/3._wp) + &
2476 tau_e_r(dir_idx_tau(1)))/rho_r) &
2477 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
2478 (((4._wp*g_l)/3._wp) + &
2479 tau_e_l(dir_idx_tau(1)))/rho_l))
2480 else if (hyperelasticity) then
2481 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l) &
2482 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
2483 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r) &
2484 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
2485 else
2486 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2487 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2488 end if
2489
2490 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
2491 (s_l - vel_l(dir_idx(1))) - &
2492 rho_r*vel_r(dir_idx(1))* &
2493 (s_r - vel_r(dir_idx(1)))) &
2494 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
2495 rho_r*(s_r - vel_r(dir_idx(1))))
2496 elseif (wave_speeds == 2) then
2497 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
2498 (vel_l(dir_idx(1)) - &
2499 vel_r(dir_idx(1))))
2500
2501 pres_sr = pres_sl
2502
2503 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
2504 (pres_sl/pres_l - 1._wp)*pres_l/ &
2505 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2506 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
2507 (pres_sr/pres_r - 1._wp)*pres_r/ &
2508 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2509
2510 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2511 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2512
2513 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
2514 (pres_l - pres_r)/ &
2515 (rho_avg*c_avg))
2516 end if
2517
2518 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2519
2520 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) &
2521 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
2522 *(5.e-1_wp + sign(5.e-1_wp, s_r))
2523 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) &
2524 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
2525 *(5.e-1_wp + sign(5.e-1_wp, s_r))
2526
2527 ! Low Mach correction
2528 if (low_mach == 1) then
2529
2530# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2531 if (riemann_solver == 1 .or. riemann_solver == 5) then
2532# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2533
2534# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2535 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2536# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2537 pcorr = 0._wp
2538# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2539
2540# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2541 if (low_mach == 1) then
2542# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2543 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2544# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2545 end if
2546# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2547
2548# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2549 else if (riemann_solver == 2) then
2550# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2551 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2552# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2553 pcorr = 0._wp
2554# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2555
2556# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2557 if (low_mach == 1) then
2558# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2559 pcorr = rho_l*rho_r* &
2560# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2561 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
2562# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2563 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
2564# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2565 (zcoef - 1._wp)
2566# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2567 else if (low_mach == 2) then
2568# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2569 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))))
2570# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2571 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))))
2572# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2573 vel_l(dir_idx(1)) = vel_l_tmp
2574# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2575 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
2580# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2581
2582 else
2583 pcorr = 0._wp
2584 end if
2585
2586 ! Mass
2587 if (.not. relativity) then
2588
2589# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2590#if defined(MFC_OpenACC)
2591# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2592!$acc loop seq
2593# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2594#elif defined(MFC_OpenMP)
2595# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2596
2597# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2598#endif
2599 do i = 1, contxe
2600 flux_rsy_vf(j, k, l, i) = &
2601 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
2602 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
2603 + s_m*s_p*(alpha_rho_l(i) &
2604 - alpha_rho_r(i))) &
2605 /(s_m - s_p)
2606 end do
2607 elseif (relativity) then
2608
2609# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2610#if defined(MFC_OpenACC)
2611# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2612!$acc loop seq
2613# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2614#elif defined(MFC_OpenMP)
2615# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2616
2617# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2618#endif
2619 do i = 1, contxe
2620 flux_rsy_vf(j, k, l, i) = &
2621 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
2622 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
2623 + s_m*s_p*(ga%L*alpha_rho_l(i) &
2624 - ga%R*alpha_rho_r(i))) &
2625 /(s_m - s_p)
2626 end do
2627 end if
2628
2629 ! Momentum
2630 if (mhd .and. (.not. relativity)) then
2631
2632# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2633#if defined(MFC_OpenACC)
2634# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2635!$acc loop seq
2636# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2637#elif defined(MFC_OpenMP)
2638# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2639
2640# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2641#endif
2642 do i = 1, 3
2643 ! Flux of rho*v_i in the y direction
2644 ! = rho * v_i * v_y - B_i * B_y + delta_(y,i) * p_tot
2645 flux_rsy_vf(j, k, l, contxe + i) = &
2646 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
2647 - b%R(i)*b%R(norm_dir) &
2648 + dir_flg(i)*(pres_r + pres_mag%R)) &
2649 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
2650 - b%L(i)*b%L(norm_dir) &
2651 + dir_flg(i)*(pres_l + pres_mag%L)) &
2652 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
2653 /(s_m - s_p)
2654 end do
2655 elseif (mhd .and. relativity) then
2656
2657# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2658#if defined(MFC_OpenACC)
2659# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2660!$acc loop seq
2661# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2662#elif defined(MFC_OpenMP)
2663# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2664
2665# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2666#endif
2667 do i = 1, 3
2668 ! Flux of m_i in the y direction
2669 ! = m_i * v_y - b_i/Gamma * B_y + delta_(y,i) * p_tot
2670 flux_rsy_vf(j, k, l, contxe + i) = &
2671 (s_m*(cm%R(i)*vel_r(norm_dir) &
2672 - b4%R(i)/ga%R*b%R(norm_dir) &
2673 + dir_flg(i)*(pres_r + pres_mag%R)) &
2674 - s_p*(cm%L(i)*vel_l(norm_dir) &
2675 - b4%L(i)/ga%L*b%L(norm_dir) &
2676 + dir_flg(i)*(pres_l + pres_mag%L)) &
2677 + s_m*s_p*(cm%L(i) - cm%R(i))) &
2678 /(s_m - s_p)
2679 end do
2680 elseif (bubbles_euler) then
2681
2682# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2683#if defined(MFC_OpenACC)
2684# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2685!$acc loop seq
2686# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2687#elif defined(MFC_OpenMP)
2688# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2689
2690# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2691#endif
2692 do i = 1, num_vels
2693 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
2694 (s_m*(rho_r*vel_r(dir_idx(1)) &
2695 *vel_r(dir_idx(i)) &
2696 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
2697 - s_p*(rho_l*vel_l(dir_idx(1)) &
2698 *vel_l(dir_idx(i)) &
2699 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
2700 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2701 - rho_r*vel_r(dir_idx(i)))) &
2702 /(s_m - s_p) &
2703 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2704 end do
2705 else if (hypoelasticity) then
2706
2707# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2708#if defined(MFC_OpenACC)
2709# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2710!$acc loop seq
2711# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2712#elif defined(MFC_OpenMP)
2713# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2714
2715# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2716#endif
2717 do i = 1, num_vels
2718 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
2719 (s_m*(rho_r*vel_r(dir_idx(1)) &
2720 *vel_r(dir_idx(i)) &
2721 + dir_flg(dir_idx(i))*pres_r &
2722 - tau_e_r(dir_idx_tau(i))) &
2723 - s_p*(rho_l*vel_l(dir_idx(1)) &
2724 *vel_l(dir_idx(i)) &
2725 + dir_flg(dir_idx(i))*pres_l &
2726 - tau_e_l(dir_idx_tau(i))) &
2727 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2728 - rho_r*vel_r(dir_idx(i)))) &
2729 /(s_m - s_p)
2730 end do
2731 else
2732
2733# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2734#if defined(MFC_OpenACC)
2735# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2736!$acc loop seq
2737# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2738#elif defined(MFC_OpenMP)
2739# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2740
2741# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2742#endif
2743 do i = 1, num_vels
2744 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
2745 (s_m*(rho_r*vel_r(dir_idx(1)) &
2746 *vel_r(dir_idx(i)) &
2747 + dir_flg(dir_idx(i))*pres_r) &
2748 - s_p*(rho_l*vel_l(dir_idx(1)) &
2749 *vel_l(dir_idx(i)) &
2750 + dir_flg(dir_idx(i))*pres_l) &
2751 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2752 - rho_r*vel_r(dir_idx(i)))) &
2753 /(s_m - s_p) &
2754 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2755 end do
2756 end if
2757
2758 ! Energy
2759 if (mhd .and. (.not. relativity)) then
2760 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
2761# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2762 flux_rsy_vf(j, k, l, e_idx) = &
2763 (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))) &
2764 - 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))) &
2765 + s_m*s_p*(e_l - e_r)) &
2766 /(s_m - s_p)
2767# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2768 elseif (mhd .and. relativity) then
2769 ! energy flux = m_y - mass flux
2770 ! Hard-coded for single-component for now
2771 flux_rsy_vf(j, k, l, e_idx) = &
2772 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
2773 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
2774 + s_m*s_p*(e_l - e_r)) &
2775 /(s_m - s_p)
2776 else if (bubbles_euler) then
2777 flux_rsy_vf(j, k, l, e_idx) = &
2778 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
2779 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
2780 + s_m*s_p*(e_l - e_r)) &
2781 /(s_m - s_p) &
2782 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
2783 else if (hypoelasticity) then
2784 flux_tau_l = 0._wp; flux_tau_r = 0._wp
2785
2786# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2787#if defined(MFC_OpenACC)
2788# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2789!$acc loop seq
2790# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2791#elif defined(MFC_OpenMP)
2792# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2793
2794# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2795#endif
2796 do i = 1, num_dims
2797 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
2798 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
2799 end do
2800 flux_rsy_vf(j, k, l, e_idx) = &
2801 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
2802 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
2803 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
2804 else
2805 flux_rsy_vf(j, k, l, e_idx) = &
2806 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
2807 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
2808 + s_m*s_p*(e_l - e_r)) &
2809 /(s_m - s_p) &
2810 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
2811 end if
2812
2813 ! Elastic Stresses
2814 if (hypoelasticity) then
2815 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
2816 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
2817 (s_m*(rho_r*vel_r(dir_idx(1)) &
2818 *tau_e_r(i)) &
2819 - s_p*(rho_l*vel_l(dir_idx(1)) &
2820 *tau_e_l(i)) &
2821 + s_m*s_p*(rho_l*tau_e_l(i) &
2822 - rho_r*tau_e_r(i))) &
2823 /(s_m - s_p)
2824 end do
2825 end if
2826
2827 ! Advection
2828
2829# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2830#if defined(MFC_OpenACC)
2831# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2832!$acc loop seq
2833# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2834#elif defined(MFC_OpenMP)
2835# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2836
2837# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2838#endif
2839 do i = advxb, advxe
2840 flux_rsy_vf(j, k, l, i) = &
2841 (ql_prim_rsy_vf(j, k, l, i) &
2842 - qr_prim_rsy_vf(j + 1, k, l, i)) &
2843 *s_m*s_p/(s_m - s_p)
2844 flux_src_rsy_vf(j, k, l, i) = &
2845 (s_m*qr_prim_rsy_vf(j + 1, k, l, i) &
2846 - s_p*ql_prim_rsy_vf(j, k, l, i)) &
2847 /(s_m - s_p)
2848 end do
2849
2850 if (bubbles_euler) then
2851 ! From HLLC: Kills mass transport @ bubble gas density
2852 if (num_fluids > 1) then
2853 flux_rsy_vf(j, k, l, contxe) = 0._wp
2854 end if
2855 end if
2856
2857 if (chemistry) then
2858
2859# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2860#if defined(MFC_OpenACC)
2861# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2862!$acc loop seq
2863# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2864#elif defined(MFC_OpenMP)
2865# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2866
2867# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2868#endif
2869 do i = chemxb, chemxe
2870 y_l = ql_prim_rsy_vf(j, k, l, i)
2871 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
2872
2873 flux_rsy_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
2874 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
2875 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
2876 /(s_m - s_p)
2877 flux_src_rsy_vf(j, k, l, i) = 0._wp
2878 end do
2879 end if
2880
2881 if (mhd) then
2882 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
2883 ! B_y flux = v_x * B_y - v_y * Bx0
2884 ! B_z flux = v_x * B_z - v_z * Bx0
2885
2886# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2887#if defined(MFC_OpenACC)
2888# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2889!$acc loop seq
2890# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2891#elif defined(MFC_OpenMP)
2892# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2893
2894# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2895#endif
2896 do i = 0, 1
2897 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
2898 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
2899 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
2900 end do
2901 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
2902 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y)
2903 ! B_y d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y)
2904 ! B_z d/dy flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
2905
2906# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2907#if defined(MFC_OpenACC)
2908# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2909!$acc loop seq
2910# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2911#elif defined(MFC_OpenMP)
2912# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2913
2914# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2915#endif
2916 do i = 0, 2
2917 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)) - &
2918 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
2919 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
2920 end do
2921
2922 if (hyper_cleaning) then
2923 ! propagate magnetic field divergence as a wave
2924 flux_rsy_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsy_vf(j, k, l, b_idx%beg + norm_dir - 1) + &
2925 (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)
2926
2927 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)
2928 else
2929 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
2930 end if
2931 end if
2932 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
2933 end if
2934
2935# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2936 if (cyl_coord) then
2937 !Substituting the advective flux into the inviscid geometrical source flux
2938
2939# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2940#if defined(MFC_OpenACC)
2941# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2942!$acc loop seq
2943# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2944#elif defined(MFC_OpenMP)
2945# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2946
2947# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2948#endif
2949 do i = 1, e_idx
2950 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2951 end do
2952 ! Recalculating the radial momentum geometric source flux
2953 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
2954 flux_rsy_vf(j, k, l, contxe + 2) &
2955 - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
2956 ! Geometrical source of the void fraction(s) is zero
2957
2958# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2959#if defined(MFC_OpenACC)
2960# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2961!$acc loop seq
2962# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2963#elif defined(MFC_OpenMP)
2964# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2965
2966# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2967#endif
2968 do i = advxb, advxe
2969 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2970 end do
2971 end if
2972
2973 if (cyl_coord .and. hypoelasticity) then
2974 ! += tau_sigmasigma using HLL
2975 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
2976 flux_gsrc_rsy_vf(j, k, l, contxe + 2) + &
2977 (s_m*tau_e_r(4) - s_p*tau_e_l(4)) &
2978 /(s_m - s_p)
2979
2980
2981# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2982#if defined(MFC_OpenACC)
2983# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2984!$acc loop seq
2985# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2986#elif defined(MFC_OpenMP)
2987# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2988
2989# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2990#endif
2991 do i = strxb, strxe
2992 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2993 end do
2994 end if
2995# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2996
2997 end do
2998 end do
2999 end do
3000
3001# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3002
3003# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3004#if defined(MFC_OpenACC)
3005# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3006!$acc end parallel loop
3007# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3008#elif defined(MFC_OpenMP)
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
3013# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3014!$omp end target teams loop
3015# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3016#endif
3017# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3018
3019 end if
3020
3021# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3022
3023 if (norm_dir == 3) then
3024
3025# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3026
3027# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3028#if defined(MFC_OpenACC)
3029# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3030!$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)
3031# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3032#elif defined(MFC_OpenMP)
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
3039# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3040!$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)
3041# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3042#endif
3043# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3044
3045 do l = is3%beg, is3%end
3046 do k = is2%beg, is2%end
3047 do j = is1%beg, is1%end
3048
3049# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3050#if defined(MFC_OpenACC)
3051# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3052!$acc loop seq
3053# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3054#elif defined(MFC_OpenMP)
3055# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3056
3057# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3058#endif
3059 do i = 1, contxe
3060 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
3061 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
3062 end do
3063
3064 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3065
3066
3067# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3068#if defined(MFC_OpenACC)
3069# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3070!$acc loop seq
3071# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3072#elif defined(MFC_OpenMP)
3073# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3074
3075# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3076#endif
3077 do i = 1, num_vels
3078 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
3079 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
3080 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3081 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3082 end do
3083
3084
3085# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3086#if defined(MFC_OpenACC)
3087# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3088!$acc loop seq
3089# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3090#elif defined(MFC_OpenMP)
3091# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3092
3093# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3094#endif
3095 do i = 1, num_fluids
3096 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
3097 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
3098 end do
3099
3100 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
3101 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
3102
3103 if (mhd) then
3104 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
3105 b%L(1) = bx0
3106 b%R(1) = bx0
3107 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
3108 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
3109 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
3110 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
3111 else ! 2D/3D: Bx, By, Bz as variables
3112 b%L(1) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
3113 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
3114 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
3115 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
3116 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 2)
3117 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 2)
3118 end if
3119 end if
3120
3121 rho_l = 0._wp
3122 gamma_l = 0._wp
3123 pi_inf_l = 0._wp
3124 qv_l = 0._wp
3125
3126 rho_r = 0._wp
3127 gamma_r = 0._wp
3128 pi_inf_r = 0._wp
3129 qv_r = 0._wp
3130
3131 alpha_l_sum = 0._wp
3132 alpha_r_sum = 0._wp
3133
3134 pres_mag%L = 0._wp
3135 pres_mag%R = 0._wp
3136
3137 if (mpp_lim) then
3138
3139# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3140#if defined(MFC_OpenACC)
3141# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3142!$acc loop seq
3143# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3144#elif defined(MFC_OpenMP)
3145# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3146
3147# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3148#endif
3149 do i = 1, num_fluids
3150 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
3151 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
3152 alpha_l_sum = alpha_l_sum + alpha_l(i)
3153 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
3154 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
3155 alpha_r_sum = alpha_r_sum + alpha_r(i)
3156 end do
3157
3158 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
3159 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
3160 end if
3161
3162
3163# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3164#if defined(MFC_OpenACC)
3165# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3166!$acc loop seq
3167# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3168#elif defined(MFC_OpenMP)
3169# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3170
3171# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3172#endif
3173 do i = 1, num_fluids
3174 rho_l = rho_l + alpha_rho_l(i)
3175 gamma_l = gamma_l + alpha_l(i)*gammas(i)
3176 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
3177 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
3178
3179 rho_r = rho_r + alpha_rho_r(i)
3180 gamma_r = gamma_r + alpha_r(i)*gammas(i)
3181 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
3182 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
3183 end do
3184
3185 if (viscous) then
3186
3187# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3188#if defined(MFC_OpenACC)
3189# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3190!$acc loop seq
3191# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3192#elif defined(MFC_OpenMP)
3193# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3194
3195# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3196#endif
3197 do i = 1, 2
3198 re_l(i) = dflt_real
3199 re_r(i) = dflt_real
3200
3201 if (re_size(i) > 0) re_l(i) = 0._wp
3202 if (re_size(i) > 0) re_r(i) = 0._wp
3203
3204
3205# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3206#if defined(MFC_OpenACC)
3207# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3208!$acc loop seq
3209# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3210#elif defined(MFC_OpenMP)
3211# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3212
3213# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3214#endif
3215 do q = 1, re_size(i)
3216 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
3217 + re_l(i)
3218 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
3219 + re_r(i)
3220 end do
3221
3222 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3223 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3224 end do
3225 end if
3226
3227 if (chemistry) then
3228
3229# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3230#if defined(MFC_OpenACC)
3231# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3232!$acc loop seq
3233# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3234#elif defined(MFC_OpenMP)
3235# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3236
3237# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3238#endif
3239 do i = chemxb, chemxe
3240 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
3241 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
3242 end do
3243
3244 call get_mixture_molecular_weight(ys_l, mw_l)
3245 call get_mixture_molecular_weight(ys_r, mw_r)
3246# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3247 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3248 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3249# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3250
3251 r_gas_l = gas_constant/mw_l
3252 r_gas_r = gas_constant/mw_r
3253 t_l = pres_l/rho_l/r_gas_l
3254 t_r = pres_r/rho_r/r_gas_r
3255
3256 call get_species_specific_heats_r(t_l, cp_il)
3257 call get_species_specific_heats_r(t_r, cp_ir)
3258
3259 if (chem_params%gamma_method == 1) then
3260 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3261 gamma_il = cp_il/(cp_il - 1.0_wp)
3262 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3263
3264 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3265 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3266 else if (chem_params%gamma_method == 2) then
3267 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3268 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3269 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3270 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3271 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3272
3273 gamm_l = cp_l/cv_l
3274 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
3275 gamm_r = cp_r/cv_r
3276 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3277 end if
3278
3279 call get_mixture_energy_mass(t_l, ys_l, e_l)
3280 call get_mixture_energy_mass(t_r, ys_r, e_r)
3281
3282 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3283 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3284 h_l = (e_l + pres_l)/rho_l
3285 h_r = (e_r + pres_r)/rho_r
3286 elseif (mhd .and. relativity) then
3287 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
3288 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
3289# 533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3290 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
3291 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
3292
3293 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
3294 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
3295 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
3296 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
3297# 541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3298
3299 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
3300 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
3301
3302 ! Hard-coded EOS
3303 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
3304 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
3305# 549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3306 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
3307 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
3308# 552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3309
3310 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
3311 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
3312 elseif (mhd .and. .not. relativity) then
3313# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3314 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
3315 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
3316# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3317 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
3318 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
3319 h_l = (e_l + pres_l - pres_mag%L)/rho_l
3320 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
3321 else
3322 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
3323 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
3324 h_l = (e_l + pres_l)/rho_l
3325 h_r = (e_r + pres_r)/rho_r
3326 end if
3327
3328 ! elastic energy update
3329 if (hypoelasticity) then
3330 g_l = 0._wp; g_r = 0._wp
3331
3332
3333# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3334#if defined(MFC_OpenACC)
3335# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3336!$acc loop seq
3337# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3338#elif defined(MFC_OpenMP)
3339# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3340
3341# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3342#endif
3343 do i = 1, num_fluids
3344 g_l = g_l + alpha_l(i)*gs_rs(i)
3345 g_r = g_r + alpha_r(i)*gs_rs(i)
3346 end do
3347
3348 if (cont_damage) then
3349 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
3350 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
3351 end if
3352
3353
3354# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3355#if defined(MFC_OpenACC)
3356# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3357!$acc loop seq
3358# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3359#elif defined(MFC_OpenMP)
3360# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3361
3362# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3363#endif
3364 do i = 1, strxe - strxb + 1
3365 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
3366 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
3367 ! Elastic contribution to energy if G large enough
3368 !TODO take out if statement if stable without
3369 if ((g_l > 1000) .and. (g_r > 1000)) then
3370 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3371 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3372 ! Double for shear stresses
3373 if (any(strxb - 1 + i == shear_indices)) then
3374 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3375 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3376 end if
3377 end if
3378 end do
3379 end if
3380
3381 ! elastic energy update
3382 !if ( hyperelasticity ) then
3383 ! G_L = 0._wp
3384 ! G_R = 0._wp
3385 !
3386 ! $:GPU_LOOP(parallelism='[seq]')
3387 ! do i = 1, num_fluids
3388 ! G_L = G_L + alpha_L(i)*Gs_rs(i)
3389 ! G_R = G_R + alpha_R(i)*Gs_rs(i)
3390 ! end do
3391 ! ! Elastic contribution to energy if G large enough
3392 ! if ((G_L > 1.e-3_wp) .and. (G_R > 1.e-3_wp)) then
3393 ! E_L = E_L + G_L*qL_prim_rsz_vf(j, k, l, xiend + 1)
3394 ! E_R = E_R + G_R*qR_prim_rsz_vf(j + 1, k, l, xiend + 1)
3395 ! $:GPU_LOOP(parallelism='[seq]')
3396 ! do i = 1, b_size-1
3397 ! tau_e_L(i) = G_L*qL_prim_rsz_vf(j, k, l, strxb - 1 + i)
3398 ! tau_e_R(i) = G_R*qR_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
3399 ! end do
3400 ! $:GPU_LOOP(parallelism='[seq]')
3401 ! do i = 1, b_size-1
3402 ! tau_e_L(i) = 0._wp
3403 ! tau_e_R(i) = 0._wp
3404 ! end do
3405 ! $:GPU_LOOP(parallelism='[seq]')
3406 ! do i = 1, num_dims
3407 ! xi_field_L(i) = qL_prim_rsz_vf(j, k, l, xibeg - 1 + i)
3408 ! xi_field_R(i) = qR_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
3409 ! end do
3410 ! end if
3411 !end if
3412
3413
3414# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3415 if (avg_state == 1) then
3416# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3417
3418# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3419 rho_avg = sqrt(rho_l*rho_r)
3420# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3421
3422# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3423 vel_avg_rms = 0._wp
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
3428# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3429#if defined(MFC_OpenACC)
3430# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3431!$acc loop seq
3432# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3433#elif defined(MFC_OpenMP)
3434# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3435
3436# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3437#endif
3438# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3439 do i = 1, num_vels
3440# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3441 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
3442# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3443 (sqrt(rho_l) + sqrt(rho_r))**2._wp
3444# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3445 end do
3446# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3447
3448# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3449 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
3450# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3451 (sqrt(rho_l) + sqrt(rho_r))
3452# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3453
3454# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3455 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
3456# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3457 (sqrt(rho_l) + sqrt(rho_r))
3458# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3459
3460# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3461 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
3462# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3463 (sqrt(rho_l) + sqrt(rho_r))**2._wp
3464# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3465
3466# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3467 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
3468# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3469 (sqrt(rho_l) + sqrt(rho_r))
3470# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3471
3472# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3473 if (chemistry) then
3474# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3475 eps = 0.001_wp
3476# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3477 call get_species_enthalpies_rt(t_l, h_il)
3478# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3479 call get_species_enthalpies_rt(t_r, h_ir)
3480# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3481 h_il = h_il*gas_constant/molecular_weights*t_l
3482# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3483 h_ir = h_ir*gas_constant/molecular_weights*t_r
3484# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3485 call get_species_specific_heats_r(t_l, cp_il)
3486# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3487 call get_species_specific_heats_r(t_r, cp_ir)
3488# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3489
3490# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3491 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3492# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3493 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3494# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3495 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3496# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3497 if (abs(t_l - t_r) < eps) then
3498# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3499 ! Case when T_L and T_R are very close
3500# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3501 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3502# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3503 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
3504# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3505 else
3506# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3507 ! Normal calculation when T_L and T_R are sufficiently different
3508# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3509 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3510# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3511 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3512# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3513 end if
3514# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3515 gamma_avg = cp_avg/cv_avg
3516# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3517
3518# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3519 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3520# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3521 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3522# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3523
3524# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3525 end if
3526# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3527
3528# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3529 end if
3530# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3531
3532# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3533 if (avg_state == 2) then
3534# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3535 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3536# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3537 vel_avg_rms = 0._wp
3538# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3539
3540# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3541#if defined(MFC_OpenACC)
3542# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3543!$acc loop seq
3544# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3545#elif defined(MFC_OpenMP)
3546# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3547
3548# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3549#endif
3550# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3551 do i = 1, num_vels
3552# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3553 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3554# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3555 end do
3556# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3557
3558# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3559 h_avg = 5.e-1_wp*(h_l + h_r)
3560# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3561 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3562# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3563 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3564# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3565
3566# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3567 end if
3568# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3569
3570
3571 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
3572 vel_l_rms, 0._wp, c_l, qv_l)
3573
3574 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
3575 vel_r_rms, 0._wp, c_r, qv_r)
3576
3577 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3578 ! variables are placeholders to call the subroutine.
3579
3580 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
3581 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
3582
3583 if (mhd) then
3584 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
3585 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
3586 end if
3587
3588 if (hyper_cleaning) then ! mhd
3589 c_fast%L = min(c_fast%L, -hyper_cleaning_speed)
3590 c_fast%R = max(c_fast%R, hyper_cleaning_speed)
3591 end if
3592
3593 if (viscous) then
3594 if (chemistry) then
3595 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3596 end if
3597
3598# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3599#if defined(MFC_OpenACC)
3600# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3601!$acc loop seq
3602# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3603#elif defined(MFC_OpenMP)
3604# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3605
3606# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3607#endif
3608 do i = 1, 2
3609 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3610 end do
3611 end if
3612
3613 if (wave_speeds == 1) then
3614 if (mhd) then
3615 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
3616 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
3617 elseif (hypoelasticity) then
3618 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
3619 (((4._wp*g_l)/3._wp) + &
3620 tau_e_l(dir_idx_tau(1)))/rho_l) &
3621 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
3622 (((4._wp*g_r)/3._wp) + &
3623 tau_e_r(dir_idx_tau(1)))/rho_r))
3624 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
3625 (((4._wp*g_r)/3._wp) + &
3626 tau_e_r(dir_idx_tau(1)))/rho_r) &
3627 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
3628 (((4._wp*g_l)/3._wp) + &
3629 tau_e_l(dir_idx_tau(1)))/rho_l))
3630 else if (hyperelasticity) then
3631 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l) &
3632 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
3633 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r) &
3634 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
3635 else
3636 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3637 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3638 end if
3639
3640 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
3641 (s_l - vel_l(dir_idx(1))) - &
3642 rho_r*vel_r(dir_idx(1))* &
3643 (s_r - vel_r(dir_idx(1)))) &
3644 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
3645 rho_r*(s_r - vel_r(dir_idx(1))))
3646 elseif (wave_speeds == 2) then
3647 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
3648 (vel_l(dir_idx(1)) - &
3649 vel_r(dir_idx(1))))
3650
3651 pres_sr = pres_sl
3652
3653 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
3654 (pres_sl/pres_l - 1._wp)*pres_l/ &
3655 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3656 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
3657 (pres_sr/pres_r - 1._wp)*pres_r/ &
3658 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3659
3660 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3661 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3662
3663 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
3664 (pres_l - pres_r)/ &
3665 (rho_avg*c_avg))
3666 end if
3667
3668 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3669
3670 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) &
3671 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
3672 *(5.e-1_wp + sign(5.e-1_wp, s_r))
3673 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) &
3674 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
3675 *(5.e-1_wp + sign(5.e-1_wp, s_r))
3676
3677 ! Low Mach correction
3678 if (low_mach == 1) then
3679
3680# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3681 if (riemann_solver == 1 .or. riemann_solver == 5) then
3682# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3683
3684# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3685 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3686# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3687 pcorr = 0._wp
3688# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3689
3690# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3691 if (low_mach == 1) then
3692# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3693 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3694# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3695 end if
3696# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3697
3698# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3699 else if (riemann_solver == 2) then
3700# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3701 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3702# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3703 pcorr = 0._wp
3704# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3705
3706# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3707 if (low_mach == 1) then
3708# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3709 pcorr = rho_l*rho_r* &
3710# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3711 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
3712# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3713 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
3714# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3715 (zcoef - 1._wp)
3716# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3717 else if (low_mach == 2) then
3718# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3719 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))))
3720# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3721 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))))
3722# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3723 vel_l(dir_idx(1)) = vel_l_tmp
3724# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3725 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
3730# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3731
3732 else
3733 pcorr = 0._wp
3734 end if
3735
3736 ! Mass
3737 if (.not. relativity) then
3738
3739# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3740#if defined(MFC_OpenACC)
3741# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3742!$acc loop seq
3743# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3744#elif defined(MFC_OpenMP)
3745# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3746
3747# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3748#endif
3749 do i = 1, contxe
3750 flux_rsz_vf(j, k, l, i) = &
3751 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
3752 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
3753 + s_m*s_p*(alpha_rho_l(i) &
3754 - alpha_rho_r(i))) &
3755 /(s_m - s_p)
3756 end do
3757 elseif (relativity) then
3758
3759# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3760#if defined(MFC_OpenACC)
3761# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3762!$acc loop seq
3763# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3764#elif defined(MFC_OpenMP)
3765# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3766
3767# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3768#endif
3769 do i = 1, contxe
3770 flux_rsz_vf(j, k, l, i) = &
3771 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
3772 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
3773 + s_m*s_p*(ga%L*alpha_rho_l(i) &
3774 - ga%R*alpha_rho_r(i))) &
3775 /(s_m - s_p)
3776 end do
3777 end if
3778
3779 ! Momentum
3780 if (mhd .and. (.not. relativity)) then
3781
3782# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3783#if defined(MFC_OpenACC)
3784# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3785!$acc loop seq
3786# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3787#elif defined(MFC_OpenMP)
3788# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3789
3790# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3791#endif
3792 do i = 1, 3
3793 ! Flux of rho*v_i in the z direction
3794 ! = rho * v_i * v_z - B_i * B_z + delta_(z,i) * p_tot
3795 flux_rsz_vf(j, k, l, contxe + i) = &
3796 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
3797 - b%R(i)*b%R(norm_dir) &
3798 + dir_flg(i)*(pres_r + pres_mag%R)) &
3799 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
3800 - b%L(i)*b%L(norm_dir) &
3801 + dir_flg(i)*(pres_l + pres_mag%L)) &
3802 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
3803 /(s_m - s_p)
3804 end do
3805 elseif (mhd .and. relativity) then
3806
3807# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3808#if defined(MFC_OpenACC)
3809# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3810!$acc loop seq
3811# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3812#elif defined(MFC_OpenMP)
3813# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3814
3815# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3816#endif
3817 do i = 1, 3
3818 ! Flux of m_i in the z direction
3819 ! = m_i * v_z - b_i/Gamma * B_z + delta_(z,i) * p_tot
3820 flux_rsz_vf(j, k, l, contxe + i) = &
3821 (s_m*(cm%R(i)*vel_r(norm_dir) &
3822 - b4%R(i)/ga%R*b%R(norm_dir) &
3823 + dir_flg(i)*(pres_r + pres_mag%R)) &
3824 - s_p*(cm%L(i)*vel_l(norm_dir) &
3825 - b4%L(i)/ga%L*b%L(norm_dir) &
3826 + dir_flg(i)*(pres_l + pres_mag%L)) &
3827 + s_m*s_p*(cm%L(i) - cm%R(i))) &
3828 /(s_m - s_p)
3829 end do
3830 elseif (bubbles_euler) then
3831
3832# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3833#if defined(MFC_OpenACC)
3834# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3835!$acc loop seq
3836# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3837#elif defined(MFC_OpenMP)
3838# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3839
3840# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3841#endif
3842 do i = 1, num_vels
3843 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
3844 (s_m*(rho_r*vel_r(dir_idx(1)) &
3845 *vel_r(dir_idx(i)) &
3846 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
3847 - s_p*(rho_l*vel_l(dir_idx(1)) &
3848 *vel_l(dir_idx(i)) &
3849 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
3850 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3851 - rho_r*vel_r(dir_idx(i)))) &
3852 /(s_m - s_p) &
3853 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3854 end do
3855 else if (hypoelasticity) then
3856
3857# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3858#if defined(MFC_OpenACC)
3859# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3860!$acc loop seq
3861# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3862#elif defined(MFC_OpenMP)
3863# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3864
3865# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3866#endif
3867 do i = 1, num_vels
3868 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
3869 (s_m*(rho_r*vel_r(dir_idx(1)) &
3870 *vel_r(dir_idx(i)) &
3871 + dir_flg(dir_idx(i))*pres_r &
3872 - tau_e_r(dir_idx_tau(i))) &
3873 - s_p*(rho_l*vel_l(dir_idx(1)) &
3874 *vel_l(dir_idx(i)) &
3875 + dir_flg(dir_idx(i))*pres_l &
3876 - tau_e_l(dir_idx_tau(i))) &
3877 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3878 - rho_r*vel_r(dir_idx(i)))) &
3879 /(s_m - s_p)
3880 end do
3881 else
3882
3883# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3884#if defined(MFC_OpenACC)
3885# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3886!$acc loop seq
3887# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3888#elif defined(MFC_OpenMP)
3889# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3890
3891# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3892#endif
3893 do i = 1, num_vels
3894 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
3895 (s_m*(rho_r*vel_r(dir_idx(1)) &
3896 *vel_r(dir_idx(i)) &
3897 + dir_flg(dir_idx(i))*pres_r) &
3898 - s_p*(rho_l*vel_l(dir_idx(1)) &
3899 *vel_l(dir_idx(i)) &
3900 + dir_flg(dir_idx(i))*pres_l) &
3901 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3902 - rho_r*vel_r(dir_idx(i)))) &
3903 /(s_m - s_p) &
3904 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3905 end do
3906 end if
3907
3908 ! Energy
3909 if (mhd .and. (.not. relativity)) then
3910 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
3911# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3912 flux_rsz_vf(j, k, l, e_idx) = &
3913 (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))) &
3914 - 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))) &
3915 + s_m*s_p*(e_l - e_r)) &
3916 /(s_m - s_p)
3917# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3918 elseif (mhd .and. relativity) then
3919 ! energy flux = m_z - mass flux
3920 ! Hard-coded for single-component for now
3921 flux_rsz_vf(j, k, l, e_idx) = &
3922 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
3923 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
3924 + s_m*s_p*(e_l - e_r)) &
3925 /(s_m - s_p)
3926 else if (bubbles_euler) then
3927 flux_rsz_vf(j, k, l, e_idx) = &
3928 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
3929 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
3930 + s_m*s_p*(e_l - e_r)) &
3931 /(s_m - s_p) &
3932 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
3933 else if (hypoelasticity) then
3934 flux_tau_l = 0._wp; flux_tau_r = 0._wp
3935
3936# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3937#if defined(MFC_OpenACC)
3938# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3939!$acc loop seq
3940# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3941#elif defined(MFC_OpenMP)
3942# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3943
3944# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3945#endif
3946 do i = 1, num_dims
3947 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
3948 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
3949 end do
3950 flux_rsz_vf(j, k, l, e_idx) = &
3951 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
3952 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
3953 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
3954 else
3955 flux_rsz_vf(j, k, l, e_idx) = &
3956 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
3957 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
3958 + s_m*s_p*(e_l - e_r)) &
3959 /(s_m - s_p) &
3960 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
3961 end if
3962
3963 ! Elastic Stresses
3964 if (hypoelasticity) then
3965 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
3966 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
3967 (s_m*(rho_r*vel_r(dir_idx(1)) &
3968 *tau_e_r(i)) &
3969 - s_p*(rho_l*vel_l(dir_idx(1)) &
3970 *tau_e_l(i)) &
3971 + s_m*s_p*(rho_l*tau_e_l(i) &
3972 - rho_r*tau_e_r(i))) &
3973 /(s_m - s_p)
3974 end do
3975 end if
3976
3977 ! Advection
3978
3979# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3980#if defined(MFC_OpenACC)
3981# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3982!$acc loop seq
3983# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3984#elif defined(MFC_OpenMP)
3985# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3986
3987# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3988#endif
3989 do i = advxb, advxe
3990 flux_rsz_vf(j, k, l, i) = &
3991 (ql_prim_rsz_vf(j, k, l, i) &
3992 - qr_prim_rsz_vf(j + 1, k, l, i)) &
3993 *s_m*s_p/(s_m - s_p)
3994 flux_src_rsz_vf(j, k, l, i) = &
3995 (s_m*qr_prim_rsz_vf(j + 1, k, l, i) &
3996 - s_p*ql_prim_rsz_vf(j, k, l, i)) &
3997 /(s_m - s_p)
3998 end do
3999
4000 if (bubbles_euler) then
4001 ! From HLLC: Kills mass transport @ bubble gas density
4002 if (num_fluids > 1) then
4003 flux_rsz_vf(j, k, l, contxe) = 0._wp
4004 end if
4005 end if
4006
4007 if (chemistry) then
4008
4009# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4010#if defined(MFC_OpenACC)
4011# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4012!$acc loop seq
4013# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4014#elif defined(MFC_OpenMP)
4015# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4016
4017# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4018#endif
4019 do i = chemxb, chemxe
4020 y_l = ql_prim_rsz_vf(j, k, l, i)
4021 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
4022
4023 flux_rsz_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
4024 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4025 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
4026 /(s_m - s_p)
4027 flux_src_rsz_vf(j, k, l, i) = 0._wp
4028 end do
4029 end if
4030
4031 if (mhd) then
4032 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4033 ! B_y flux = v_x * B_y - v_y * Bx0
4034 ! B_z flux = v_x * B_z - v_z * Bx0
4035
4036# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4037#if defined(MFC_OpenACC)
4038# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4039!$acc loop seq
4040# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4041#elif defined(MFC_OpenMP)
4042# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4043
4044# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4045#endif
4046 do i = 0, 1
4047 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
4048 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
4049 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
4050 end do
4051 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
4052 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z)
4053 ! B_y d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z)
4054 ! B_z d/dz flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
4055
4056# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4057#if defined(MFC_OpenACC)
4058# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4059!$acc loop seq
4060# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4061#elif defined(MFC_OpenMP)
4062# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4063
4064# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4065#endif
4066 do i = 0, 2
4067 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)) - &
4068 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
4069 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
4070 end do
4071
4072 if (hyper_cleaning) then
4073 ! propagate magnetic field divergence as a wave
4074 flux_rsz_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsz_vf(j, k, l, b_idx%beg + norm_dir - 1) + &
4075 (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)
4076
4077 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)
4078 else
4079 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
4080 end if
4081 end if
4082 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
4083 end if
4084
4085# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4086
4087 end do
4088 end do
4089 end do
4090
4091# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4092
4093# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4094#if defined(MFC_OpenACC)
4095# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4096!$acc end parallel loop
4097# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4098#elif defined(MFC_OpenMP)
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
4103# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4104!$omp end target teams loop
4105# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4106#endif
4107# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4108
4109 end if
4110
4111# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4112
4113 if (viscous .or. dummy) then
4114 if (weno_re_flux) then
4115
4116 call s_compute_viscous_source_flux( &
4117 ql_prim_vf(momxb:momxe), &
4118 dql_prim_dx_vf(momxb:momxe), &
4119 dql_prim_dy_vf(momxb:momxe), &
4120 dql_prim_dz_vf(momxb:momxe), &
4121 qr_prim_vf(momxb:momxe), &
4122 dqr_prim_dx_vf(momxb:momxe), &
4123 dqr_prim_dy_vf(momxb:momxe), &
4124 dqr_prim_dz_vf(momxb:momxe), &
4125 flux_src_vf, norm_dir, ix, iy, iz)
4126 else
4127 call s_compute_viscous_source_flux( &
4128 q_prim_vf(momxb:momxe), &
4129 dql_prim_dx_vf(momxb:momxe), &
4130 dql_prim_dy_vf(momxb:momxe), &
4131 dql_prim_dz_vf(momxb:momxe), &
4132 q_prim_vf(momxb:momxe), &
4133 dqr_prim_dx_vf(momxb:momxe), &
4134 dqr_prim_dy_vf(momxb:momxe), &
4135 dqr_prim_dz_vf(momxb:momxe), &
4136 flux_src_vf, norm_dir, ix, iy, iz)
4137 end if
4138 end if
4139
4140 call s_finalize_riemann_solver(flux_vf, flux_src_vf, &
4141 flux_gsrc_vf, &
4142 norm_dir)
4143
4144 end subroutine s_hll_riemann_solver
4145
4146 !> @brief Computes intercell fluxes using the Lax-Friedrichs (LF) approximate Riemann solver.
4147 subroutine s_lf_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
4148 dqL_prim_dy_vf, &
4149 dqL_prim_dz_vf, &
4150 qL_prim_vf, &
4151 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
4152 dqR_prim_dy_vf, &
4153 dqR_prim_dz_vf, &
4154 qR_prim_vf, &
4155 q_prim_vf, &
4156 flux_vf, flux_src_vf, &
4157 flux_gsrc_vf, &
4158 norm_dir, ix, iy, iz)
4159
4160 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
4161 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
4162
4163 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
4164
4165 type(scalar_field), &
4166 allocatable, dimension(:), &
4167 intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
4168 dql_prim_dy_vf, dqr_prim_dy_vf, &
4169 dql_prim_dz_vf, dqr_prim_dz_vf
4170
4171 ! Intercell fluxes
4172 type(scalar_field), &
4173 dimension(sys_size), &
4174 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
4175 real(wp) :: flux_tau_l, flux_tau_r
4176
4177 integer, intent(in) :: norm_dir
4178 type(int_bounds_info), intent(in) :: ix, iy, iz
4179# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4180 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
4181 real(wp), dimension(num_vels) :: vel_l, vel_r
4182 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
4183 real(wp), dimension(num_species) :: ys_l, ys_r
4184 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
4185 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
4186 real(wp), dimension(num_dims, num_dims) :: vel_grad_l, vel_grad_r !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
4187# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4188 real(wp) :: rho_l, rho_r
4189
4190 real(wp) :: pres_l, pres_r
4191 real(wp) :: e_l, e_r
4192 real(wp) :: h_l, h_r
4193 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
4194 real(wp) :: t_l, t_r
4195 real(wp) :: y_l, y_r
4196 real(wp) :: mw_l, mw_r
4197 real(wp) :: r_gas_l, r_gas_r
4198 real(wp) :: cp_l, cp_r
4199 real(wp) :: cv_l, cv_r
4200 real(wp) :: gamm_l, gamm_r
4201 real(wp) :: gamma_l, gamma_r
4202 real(wp) :: pi_inf_l, pi_inf_r
4203 real(wp) :: qv_l, qv_r
4204 real(wp) :: c_l, c_r
4205 real(wp), dimension(6) :: tau_e_l, tau_e_r
4206 real(wp) :: g_l, g_r
4207 real(wp), dimension(2) :: re_l, re_r
4208 real(wp), dimension(3) :: xi_field_l, xi_field_r
4209
4210 real(wp) :: rho_avg
4211 real(wp) :: h_avg
4212 real(wp) :: gamma_avg
4213 real(wp) :: c_avg
4214
4215 real(wp) :: s_l, s_r, s_m, s_p, s_s
4216 real(wp) :: xi_m, xi_p
4217
4218 real(wp) :: ptilde_l, ptilde_r
4219 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
4220 real(wp) :: vel_l_tmp, vel_r_tmp
4221 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
4222 real(wp) :: alpha_l_sum, alpha_r_sum
4223 real(wp) :: zcoef, pcorr !< low Mach number correction
4224
4225 type(riemann_states) :: c_fast, pres_mag
4226 type(riemann_states_vec3) :: b
4227
4228 type(riemann_states) :: ga ! Gamma (Lorentz factor)
4229 type(riemann_states) :: vdotb, b2
4230 type(riemann_states_vec3) :: b4 ! 4-magnetic field components (spatial: b4x, b4y, b4z)
4231 type(riemann_states_vec3) :: cm ! Conservative momentum variables
4232
4233 integer :: i, j, k, l, q !< Generic loop iterators
4234 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
4235
4236 ! Populating the buffers of the left and right Riemann problem
4237 ! states variables, based on the choice of boundary conditions
4238 call s_populate_riemann_states_variables_buffers( &
4239 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
4240 dql_prim_dy_vf, &
4241 dql_prim_dz_vf, &
4242 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
4243 dqr_prim_dy_vf, &
4244 dqr_prim_dz_vf, &
4245 norm_dir, ix, iy, iz)
4246
4247 ! Reshaping inputted data based on dimensional splitting direction
4248 call s_initialize_riemann_solver( &
4249 flux_src_vf, &
4250 norm_dir)
4251# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4252
4253 if (norm_dir == 1) then
4254
4255# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4256
4257# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4258#if defined(MFC_OpenACC)
4259# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4260!$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)
4261# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4262#elif defined(MFC_OpenMP)
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
4269# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4270!$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)
4271# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4272#endif
4273# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4274
4275 do l = is3%beg, is3%end
4276 do k = is2%beg, is2%end
4277 do j = is1%beg, is1%end
4278
4279# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4280#if defined(MFC_OpenACC)
4281# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4282!$acc loop seq
4283# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4284#elif defined(MFC_OpenMP)
4285# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4286
4287# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4288#endif
4289 do i = 1, contxe
4290 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4291 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
4292 end do
4293
4294 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4295
4296
4297# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4298#if defined(MFC_OpenACC)
4299# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4300!$acc loop seq
4301# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4302#elif defined(MFC_OpenMP)
4303# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4304
4305# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4306#endif
4307 do i = 1, num_vels
4308 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
4309 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
4310 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4311 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4312 end do
4313
4314
4315# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4316#if defined(MFC_OpenACC)
4317# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4318!$acc loop seq
4319# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4320#elif defined(MFC_OpenMP)
4321# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4322
4323# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4324#endif
4325 do i = 1, num_fluids
4326 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
4327 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
4328 end do
4329
4330 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
4331 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
4332
4333 if (mhd) then
4334 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
4335 b%L(1) = bx0
4336 b%R(1) = bx0
4337 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
4338 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
4339 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
4340 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
4341 else ! 2D/3D: Bx, By, Bz as variables
4342 b%L(1) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
4343 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
4344 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
4345 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
4346 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 2)
4347 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 2)
4348 end if
4349 end if
4350
4351 rho_l = 0._wp
4352 gamma_l = 0._wp
4353 pi_inf_l = 0._wp
4354 qv_l = 0._wp
4355
4356 rho_r = 0._wp
4357 gamma_r = 0._wp
4358 pi_inf_r = 0._wp
4359 qv_r = 0._wp
4360
4361 alpha_l_sum = 0._wp
4362 alpha_r_sum = 0._wp
4363
4364 pres_mag%L = 0._wp
4365 pres_mag%R = 0._wp
4366
4367 if (mpp_lim) then
4368
4369# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4370#if defined(MFC_OpenACC)
4371# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4372!$acc loop seq
4373# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4374#elif defined(MFC_OpenMP)
4375# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4376
4377# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4378#endif
4379 do i = 1, num_fluids
4380 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4381 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4382 alpha_l_sum = alpha_l_sum + alpha_l(i)
4383 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4384 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4385 alpha_r_sum = alpha_r_sum + alpha_r(i)
4386 end do
4387
4388 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4389 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4390 end if
4391
4392
4393# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4394#if defined(MFC_OpenACC)
4395# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4396!$acc loop seq
4397# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4398#elif defined(MFC_OpenMP)
4399# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4400
4401# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4402#endif
4403 do i = 1, num_fluids
4404 rho_l = rho_l + alpha_rho_l(i)
4405 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4406 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4407 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4408
4409 rho_r = rho_r + alpha_rho_r(i)
4410 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4411 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4412 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4413 end do
4414
4415 if (viscous) then
4416
4417# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4418#if defined(MFC_OpenACC)
4419# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4420!$acc loop seq
4421# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4422#elif defined(MFC_OpenMP)
4423# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4424
4425# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4426#endif
4427 do i = 1, 2
4428 re_l(i) = dflt_real
4429 re_r(i) = dflt_real
4430
4431 if (re_size(i) > 0) re_l(i) = 0._wp
4432 if (re_size(i) > 0) re_r(i) = 0._wp
4433
4434
4435# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4436#if defined(MFC_OpenACC)
4437# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4438!$acc loop seq
4439# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4440#elif defined(MFC_OpenMP)
4441# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4442
4443# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4444#endif
4445 do q = 1, re_size(i)
4446 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
4447 + re_l(i)
4448 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
4449 + re_r(i)
4450 end do
4451
4452 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4453 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4454 end do
4455 end if
4456
4457 if (chemistry) then
4458
4459# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4460#if defined(MFC_OpenACC)
4461# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4462!$acc loop seq
4463# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4464#elif defined(MFC_OpenMP)
4465# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4466
4467# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4468#endif
4469 do i = chemxb, chemxe
4470 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
4471 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
4472 end do
4473
4474 call get_mixture_molecular_weight(ys_l, mw_l)
4475 call get_mixture_molecular_weight(ys_r, mw_r)
4476
4477# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4478 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
4479 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
4480# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4481
4482 r_gas_l = gas_constant/mw_l
4483 r_gas_r = gas_constant/mw_r
4484 t_l = pres_l/rho_l/r_gas_l
4485 t_r = pres_r/rho_r/r_gas_r
4486
4487 call get_species_specific_heats_r(t_l, cp_il)
4488 call get_species_specific_heats_r(t_r, cp_ir)
4489
4490 if (chem_params%gamma_method == 1) then
4491 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4492 gamma_il = cp_il/(cp_il - 1.0_wp)
4493 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
4494
4495 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
4496 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
4497 else if (chem_params%gamma_method == 2) then
4498 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4499 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4500 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4501 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4502 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4503
4504 gamm_l = cp_l/cv_l
4505 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
4506 gamm_r = cp_r/cv_r
4507 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4508 end if
4509
4510 call get_mixture_energy_mass(t_l, ys_l, e_l)
4511 call get_mixture_energy_mass(t_r, ys_r, e_r)
4512
4513 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4514 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4515 h_l = (e_l + pres_l)/rho_l
4516 h_r = (e_r + pres_r)/rho_r
4517 elseif (mhd .and. relativity) then
4518# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4519 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
4520 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
4521 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
4522 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4523
4524 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4525 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4526 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4527 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4528
4529 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4530 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4531
4532 ! Hard-coded EOS
4533 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4534 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4535
4536 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4537 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4538
4539 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
4540 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
4541# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4542 elseif (mhd .and. .not. relativity) then
4543 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4544 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4545 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4546 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
4547 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4548 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4549 else
4550 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4551 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4552 h_l = (e_l + pres_l)/rho_l
4553 h_r = (e_r + pres_r)/rho_r
4554 end if
4555
4556 ! elastic energy update
4557 if (hypoelasticity) then
4558 g_l = 0._wp; g_r = 0._wp
4559
4560
4561# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4562#if defined(MFC_OpenACC)
4563# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4564!$acc loop seq
4565# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4566#elif defined(MFC_OpenMP)
4567# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4568
4569# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4570#endif
4571 do i = 1, num_fluids
4572 g_l = g_l + alpha_l(i)*gs_rs(i)
4573 g_r = g_r + alpha_r(i)*gs_rs(i)
4574 end do
4575
4576 if (cont_damage) then
4577 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
4578 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
4579 end if
4580
4581 do i = 1, strxe - strxb + 1
4582 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
4583 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
4584 ! Elastic contribution to energy if G large enough
4585 !TODO take out if statement if stable without
4586 if ((g_l > 1000) .and. (g_r > 1000)) then
4587 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4588 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4589 ! Double for shear stresses
4590 if (any(strxb - 1 + i == shear_indices)) then
4591 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4592 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4593 end if
4594 end if
4595 end do
4596 end if
4597
4598 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
4599 vel_l_rms, 0._wp, c_l, qv_l)
4600
4601 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
4602 vel_r_rms, 0._wp, c_r, qv_r)
4603
4604 if (mhd) then
4605 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4606 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4607 end if
4608
4609 s_l = 0._wp; s_r = 0._wp
4610
4611
4612# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4613#if defined(MFC_OpenACC)
4614# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4615!$acc loop seq
4616# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4617#elif defined(MFC_OpenMP)
4618# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4619
4620# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4621#endif
4622 do i = 1, num_dims
4623 s_l = s_l + vel_l(i)**2._wp
4624 s_r = s_r + vel_r(i)**2._wp
4625 end do
4626
4627 s_l = sqrt(s_l)
4628 s_r = sqrt(s_r)
4629
4630 s_p = max(s_l, s_r) + max(c_l, c_r)
4631 s_m = -s_p
4632
4633 s_l = s_m
4634 s_r = s_p
4635
4636 ! Low Mach correction
4637 if (low_mach == 1) then
4638
4639# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4640 if (riemann_solver == 1 .or. riemann_solver == 5) then
4641# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4642
4643# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4644 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4645# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4646 pcorr = 0._wp
4647# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4648
4649# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4650 if (low_mach == 1) then
4651# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4652 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4653# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4654 end if
4655# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4656
4657# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4658 else if (riemann_solver == 2) then
4659# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4660 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4661# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4662 pcorr = 0._wp
4663# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4664
4665# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4666 if (low_mach == 1) then
4667# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4668 pcorr = rho_l*rho_r* &
4669# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4670 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
4671# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4672 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
4673# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4674 (zcoef - 1._wp)
4675# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4676 else if (low_mach == 2) then
4677# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4678 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))))
4679# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4680 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))))
4681# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4682 vel_l(dir_idx(1)) = vel_l_tmp
4683# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4684 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
4689# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4690
4691 else
4692 pcorr = 0._wp
4693 end if
4694
4695 ! Mass
4696 if (.not. relativity) then
4697
4698# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4699#if defined(MFC_OpenACC)
4700# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4701!$acc loop seq
4702# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4703#elif defined(MFC_OpenMP)
4704# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4705
4706# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4707#endif
4708 do i = 1, contxe
4709 flux_rsx_vf(j, k, l, i) = &
4710 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
4711 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
4712 + s_m*s_p*(alpha_rho_l(i) &
4713 - alpha_rho_r(i))) &
4714 /(s_m - s_p)
4715 end do
4716 elseif (relativity) then
4717
4718# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4719#if defined(MFC_OpenACC)
4720# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4721!$acc loop seq
4722# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4723#elif defined(MFC_OpenMP)
4724# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4725
4726# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4727#endif
4728 do i = 1, contxe
4729 flux_rsx_vf(j, k, l, i) = &
4730 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
4731 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
4732 + s_m*s_p*(ga%L*alpha_rho_l(i) &
4733 - ga%R*alpha_rho_r(i))) &
4734 /(s_m - s_p)
4735 end do
4736 end if
4737
4738 ! Momentum
4739 if (mhd .and. (.not. relativity)) then
4740
4741# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4742#if defined(MFC_OpenACC)
4743# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4744!$acc loop seq
4745# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4746#elif defined(MFC_OpenMP)
4747# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4748
4749# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4750#endif
4751 do i = 1, 3
4752 ! Flux of rho*v_i in the x direction
4753 ! = rho * v_i * v_x - B_i * B_x + delta_(x,i) * p_tot
4754 flux_rsx_vf(j, k, l, contxe + i) = &
4755 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
4756 - b%R(i)*b%R(norm_dir) &
4757 + dir_flg(i)*(pres_r + pres_mag%R)) &
4758 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
4759 - b%L(i)*b%L(norm_dir) &
4760 + dir_flg(i)*(pres_l + pres_mag%L)) &
4761 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
4762 /(s_m - s_p)
4763 end do
4764 elseif (mhd .and. relativity) then
4765
4766# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4767#if defined(MFC_OpenACC)
4768# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4769!$acc loop seq
4770# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4771#elif defined(MFC_OpenMP)
4772# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4773
4774# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4775#endif
4776 do i = 1, 3
4777 ! Flux of m_i in the x direction
4778 ! = m_i * v_x - b_i/Gamma * B_x + delta_(x,i) * p_tot
4779 flux_rsx_vf(j, k, l, contxe + i) = &
4780 (s_m*(cm%R(i)*vel_r(norm_dir) &
4781 - b4%R(i)/ga%R*b%R(norm_dir) &
4782 + dir_flg(i)*(pres_r + pres_mag%R)) &
4783 - s_p*(cm%L(i)*vel_l(norm_dir) &
4784 - b4%L(i)/ga%L*b%L(norm_dir) &
4785 + dir_flg(i)*(pres_l + pres_mag%L)) &
4786 + s_m*s_p*(cm%L(i) - cm%R(i))) &
4787 /(s_m - s_p)
4788 end do
4789 elseif (bubbles_euler) then
4790
4791# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4792#if defined(MFC_OpenACC)
4793# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4794!$acc loop seq
4795# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4796#elif defined(MFC_OpenMP)
4797# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4798
4799# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4800#endif
4801 do i = 1, num_vels
4802 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
4803 (s_m*(rho_r*vel_r(dir_idx(1)) &
4804 *vel_r(dir_idx(i)) &
4805 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
4806 - s_p*(rho_l*vel_l(dir_idx(1)) &
4807 *vel_l(dir_idx(i)) &
4808 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4809 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4810 - rho_r*vel_r(dir_idx(i)))) &
4811 /(s_m - s_p) &
4812 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4813 end do
4814 else if (hypoelasticity) then
4815
4816# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4817#if defined(MFC_OpenACC)
4818# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4819!$acc loop seq
4820# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4821#elif defined(MFC_OpenMP)
4822# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4823
4824# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4825#endif
4826 do i = 1, num_vels
4827 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
4828 (s_m*(rho_r*vel_r(dir_idx(1)) &
4829 *vel_r(dir_idx(i)) &
4830 + dir_flg(dir_idx(i))*pres_r &
4831 - tau_e_r(dir_idx_tau(i))) &
4832 - s_p*(rho_l*vel_l(dir_idx(1)) &
4833 *vel_l(dir_idx(i)) &
4834 + dir_flg(dir_idx(i))*pres_l &
4835 - tau_e_l(dir_idx_tau(i))) &
4836 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4837 - rho_r*vel_r(dir_idx(i)))) &
4838 /(s_m - s_p)
4839 end do
4840 else
4841
4842# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4843#if defined(MFC_OpenACC)
4844# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4845!$acc loop seq
4846# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4847#elif defined(MFC_OpenMP)
4848# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4849
4850# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4851#endif
4852 do i = 1, num_vels
4853 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
4854 (s_m*(rho_r*vel_r(dir_idx(1)) &
4855 *vel_r(dir_idx(i)) &
4856 + dir_flg(dir_idx(i))*pres_r) &
4857 - s_p*(rho_l*vel_l(dir_idx(1)) &
4858 *vel_l(dir_idx(i)) &
4859 + dir_flg(dir_idx(i))*pres_l) &
4860 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4861 - rho_r*vel_r(dir_idx(i)))) &
4862 /(s_m - s_p) &
4863 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4864 end do
4865 end if
4866
4867 ! Energy
4868 if (mhd .and. (.not. relativity)) then
4869 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
4870# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4871 flux_rsx_vf(j, k, l, e_idx) = &
4872 (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))) &
4873 - 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))) &
4874 + s_m*s_p*(e_l - e_r)) &
4875 /(s_m - s_p)
4876# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4877 elseif (mhd .and. relativity) then
4878 ! energy flux = m_x - mass flux
4879 ! Hard-coded for single-component for now
4880 flux_rsx_vf(j, k, l, e_idx) = &
4881 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
4882 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
4883 + s_m*s_p*(e_l - e_r)) &
4884 /(s_m - s_p)
4885 else if (bubbles_euler) then
4886 flux_rsx_vf(j, k, l, e_idx) = &
4887 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
4888 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
4889 + s_m*s_p*(e_l - e_r)) &
4890 /(s_m - s_p) &
4891 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
4892 else if (hypoelasticity) then
4893 flux_tau_l = 0._wp; flux_tau_r = 0._wp
4894
4895# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4896#if defined(MFC_OpenACC)
4897# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4898!$acc loop seq
4899# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4900#elif defined(MFC_OpenMP)
4901# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4902
4903# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4904#endif
4905 do i = 1, num_dims
4906 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
4907 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
4908 end do
4909 flux_rsx_vf(j, k, l, e_idx) = &
4910 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
4911 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
4912 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
4913 else
4914 flux_rsx_vf(j, k, l, e_idx) = &
4915 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
4916 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
4917 + s_m*s_p*(e_l - e_r)) &
4918 /(s_m - s_p) &
4919 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
4920 end if
4921
4922 ! Elastic Stresses
4923 if (hypoelasticity) then
4924 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
4925 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
4926 (s_m*(rho_r*vel_r(dir_idx(1)) &
4927 *tau_e_r(i)) &
4928 - s_p*(rho_l*vel_l(dir_idx(1)) &
4929 *tau_e_l(i)) &
4930 + s_m*s_p*(rho_l*tau_e_l(i) &
4931 - rho_r*tau_e_r(i))) &
4932 /(s_m - s_p)
4933 end do
4934 end if
4935
4936 ! Advection
4937
4938# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4939#if defined(MFC_OpenACC)
4940# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4941!$acc loop seq
4942# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4943#elif defined(MFC_OpenMP)
4944# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4945
4946# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4947#endif
4948 do i = advxb, advxe
4949 flux_rsx_vf(j, k, l, i) = &
4950 (ql_prim_rsx_vf(j, k, l, i) &
4951 - qr_prim_rsx_vf(j + 1, k, l, i)) &
4952 *s_m*s_p/(s_m - s_p)
4953 flux_src_rsx_vf(j, k, l, i) = &
4954 (s_m*qr_prim_rsx_vf(j + 1, k, l, i) &
4955 - s_p*ql_prim_rsx_vf(j, k, l, i)) &
4956 /(s_m - s_p)
4957 end do
4958
4959 if (bubbles_euler) then
4960 ! From HLLC: Kills mass transport @ bubble gas density
4961 if (num_fluids > 1) then
4962 flux_rsx_vf(j, k, l, contxe) = 0._wp
4963 end if
4964 end if
4965
4966 if (chemistry) then
4967
4968# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4969#if defined(MFC_OpenACC)
4970# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4971!$acc loop seq
4972# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4973#elif defined(MFC_OpenMP)
4974# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4975
4976# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4977#endif
4978 do i = chemxb, chemxe
4979 y_l = ql_prim_rsx_vf(j, k, l, i)
4980 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
4981
4982 flux_rsx_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
4983 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4984 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
4985 /(s_m - s_p)
4986 flux_src_rsx_vf(j, k, l, i) = 0._wp
4987 end do
4988 end if
4989
4990 if (mhd) then
4991 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4992 ! B_y flux = v_x * B_y - v_y * Bx0
4993 ! B_z flux = v_x * B_z - v_z * Bx0
4994
4995# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4996#if defined(MFC_OpenACC)
4997# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4998!$acc loop seq
4999# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5000#elif defined(MFC_OpenMP)
5001# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5002
5003# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5004#endif
5005 do i = 0, 1
5006 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5007 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
5008 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
5009 end do
5010 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5011 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x)
5012 ! B_y d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x)
5013 ! B_z d/dx flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
5014
5015# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5016#if defined(MFC_OpenACC)
5017# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5018!$acc loop seq
5019# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5020#elif defined(MFC_OpenMP)
5021# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5022
5023# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5024#endif
5025 do i = 0, 2
5026 flux_rsx_vf(j, k, l, b_idx%beg + i) = (1 - dir_flg(i + 1))*( &
5027 s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
5028 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
5029 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5030 end do
5031 end if
5032 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
5033 end if
5034
5035# 1682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5036 end do
5037 end do
5038 end do
5039
5040# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5041
5042# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5043#if defined(MFC_OpenACC)
5044# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5045!$acc end parallel loop
5046# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5047#elif defined(MFC_OpenMP)
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
5052# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5053!$omp end target teams loop
5054# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5055#endif
5056# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5057
5058 end if
5059
5060# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5061
5062 if (norm_dir == 2) then
5063
5064# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5065
5066# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5067#if defined(MFC_OpenACC)
5068# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5069!$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)
5070# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5071#elif defined(MFC_OpenMP)
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
5078# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5079!$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)
5080# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5081#endif
5082# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5083
5084 do l = is3%beg, is3%end
5085 do k = is2%beg, is2%end
5086 do j = is1%beg, is1%end
5087
5088# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5089#if defined(MFC_OpenACC)
5090# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5091!$acc loop seq
5092# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5093#elif defined(MFC_OpenMP)
5094# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5095
5096# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5097#endif
5098 do i = 1, contxe
5099 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
5100 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
5101 end do
5102
5103 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5104
5105
5106# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5107#if defined(MFC_OpenACC)
5108# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5109!$acc loop seq
5110# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5111#elif defined(MFC_OpenMP)
5112# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5113
5114# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5115#endif
5116 do i = 1, num_vels
5117 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
5118 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
5119 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5120 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5121 end do
5122
5123
5124# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5125#if defined(MFC_OpenACC)
5126# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5127!$acc loop seq
5128# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5129#elif defined(MFC_OpenMP)
5130# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5131
5132# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5133#endif
5134 do i = 1, num_fluids
5135 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
5136 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
5137 end do
5138
5139 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
5140 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
5141
5142 if (mhd) then
5143 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
5144 b%L(1) = bx0
5145 b%R(1) = bx0
5146 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
5147 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
5148 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
5149 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
5150 else ! 2D/3D: Bx, By, Bz as variables
5151 b%L(1) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
5152 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
5153 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
5154 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
5155 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 2)
5156 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 2)
5157 end if
5158 end if
5159
5160 rho_l = 0._wp
5161 gamma_l = 0._wp
5162 pi_inf_l = 0._wp
5163 qv_l = 0._wp
5164
5165 rho_r = 0._wp
5166 gamma_r = 0._wp
5167 pi_inf_r = 0._wp
5168 qv_r = 0._wp
5169
5170 alpha_l_sum = 0._wp
5171 alpha_r_sum = 0._wp
5172
5173 pres_mag%L = 0._wp
5174 pres_mag%R = 0._wp
5175
5176 if (mpp_lim) then
5177
5178# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5179#if defined(MFC_OpenACC)
5180# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5181!$acc loop seq
5182# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5183#elif defined(MFC_OpenMP)
5184# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5185
5186# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5187#endif
5188 do i = 1, num_fluids
5189 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
5190 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
5191 alpha_l_sum = alpha_l_sum + alpha_l(i)
5192 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
5193 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
5194 alpha_r_sum = alpha_r_sum + alpha_r(i)
5195 end do
5196
5197 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
5198 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
5199 end if
5200
5201
5202# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5203#if defined(MFC_OpenACC)
5204# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5205!$acc loop seq
5206# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5207#elif defined(MFC_OpenMP)
5208# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5209
5210# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5211#endif
5212 do i = 1, num_fluids
5213 rho_l = rho_l + alpha_rho_l(i)
5214 gamma_l = gamma_l + alpha_l(i)*gammas(i)
5215 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
5216 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
5217
5218 rho_r = rho_r + alpha_rho_r(i)
5219 gamma_r = gamma_r + alpha_r(i)*gammas(i)
5220 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
5221 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
5222 end do
5223
5224 if (viscous) then
5225
5226# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5227#if defined(MFC_OpenACC)
5228# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5229!$acc loop seq
5230# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5231#elif defined(MFC_OpenMP)
5232# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5233
5234# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5235#endif
5236 do i = 1, 2
5237 re_l(i) = dflt_real
5238 re_r(i) = dflt_real
5239
5240 if (re_size(i) > 0) re_l(i) = 0._wp
5241 if (re_size(i) > 0) re_r(i) = 0._wp
5242
5243
5244# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5245#if defined(MFC_OpenACC)
5246# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5247!$acc loop seq
5248# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5249#elif defined(MFC_OpenMP)
5250# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5251
5252# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5253#endif
5254 do q = 1, re_size(i)
5255 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
5256 + re_l(i)
5257 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
5258 + re_r(i)
5259 end do
5260
5261 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5262 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5263 end do
5264 end if
5265
5266 if (chemistry) then
5267
5268# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5269#if defined(MFC_OpenACC)
5270# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5271!$acc loop seq
5272# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5273#elif defined(MFC_OpenMP)
5274# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5275
5276# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5277#endif
5278 do i = chemxb, chemxe
5279 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
5280 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
5281 end do
5282
5283 call get_mixture_molecular_weight(ys_l, mw_l)
5284 call get_mixture_molecular_weight(ys_r, mw_r)
5285
5286# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5287 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5288 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5289# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5290
5291 r_gas_l = gas_constant/mw_l
5292 r_gas_r = gas_constant/mw_r
5293 t_l = pres_l/rho_l/r_gas_l
5294 t_r = pres_r/rho_r/r_gas_r
5295
5296 call get_species_specific_heats_r(t_l, cp_il)
5297 call get_species_specific_heats_r(t_r, cp_ir)
5298
5299 if (chem_params%gamma_method == 1) then
5300 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5301 gamma_il = cp_il/(cp_il - 1.0_wp)
5302 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5303
5304 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5305 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5306 else if (chem_params%gamma_method == 2) then
5307 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5308 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5309 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5310 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5311 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5312
5313 gamm_l = cp_l/cv_l
5314 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
5315 gamm_r = cp_r/cv_r
5316 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5317 end if
5318
5319 call get_mixture_energy_mass(t_l, ys_l, e_l)
5320 call get_mixture_energy_mass(t_r, ys_r, e_r)
5321
5322 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5323 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5324 h_l = (e_l + pres_l)/rho_l
5325 h_r = (e_r + pres_r)/rho_r
5326 elseif (mhd .and. relativity) then
5327# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5328 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
5329 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
5330 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
5331 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
5332
5333 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
5334 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
5335 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
5336 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
5337
5338 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
5339 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
5340
5341 ! Hard-coded EOS
5342 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
5343 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
5344
5345 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
5346 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
5347
5348 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
5349 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
5350# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5351 elseif (mhd .and. .not. relativity) then
5352 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
5353 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
5354 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
5355 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
5356 h_l = (e_l + pres_l - pres_mag%L)/rho_l
5357 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
5358 else
5359 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5360 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5361 h_l = (e_l + pres_l)/rho_l
5362 h_r = (e_r + pres_r)/rho_r
5363 end if
5364
5365 ! elastic energy update
5366 if (hypoelasticity) then
5367 g_l = 0._wp; g_r = 0._wp
5368
5369
5370# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5371#if defined(MFC_OpenACC)
5372# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5373!$acc loop seq
5374# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5375#elif defined(MFC_OpenMP)
5376# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5377
5378# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5379#endif
5380 do i = 1, num_fluids
5381 g_l = g_l + alpha_l(i)*gs_rs(i)
5382 g_r = g_r + alpha_r(i)*gs_rs(i)
5383 end do
5384
5385 if (cont_damage) then
5386 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
5387 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
5388 end if
5389
5390 do i = 1, strxe - strxb + 1
5391 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
5392 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
5393 ! Elastic contribution to energy if G large enough
5394 !TODO take out if statement if stable without
5395 if ((g_l > 1000) .and. (g_r > 1000)) then
5396 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5397 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5398 ! Double for shear stresses
5399 if (any(strxb - 1 + i == shear_indices)) then
5400 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5401 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5402 end if
5403 end if
5404 end do
5405 end if
5406
5407 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
5408 vel_l_rms, 0._wp, c_l, qv_l)
5409
5410 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
5411 vel_r_rms, 0._wp, c_r, qv_r)
5412
5413 if (mhd) then
5414 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
5415 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
5416 end if
5417
5418 s_l = 0._wp; s_r = 0._wp
5419
5420
5421# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5422#if defined(MFC_OpenACC)
5423# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5424!$acc loop seq
5425# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5426#elif defined(MFC_OpenMP)
5427# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5428
5429# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5430#endif
5431 do i = 1, num_dims
5432 s_l = s_l + vel_l(i)**2._wp
5433 s_r = s_r + vel_r(i)**2._wp
5434 end do
5435
5436 s_l = sqrt(s_l)
5437 s_r = sqrt(s_r)
5438
5439 s_p = max(s_l, s_r) + max(c_l, c_r)
5440 s_m = -s_p
5441
5442 s_l = s_m
5443 s_r = s_p
5444
5445 ! Low Mach correction
5446 if (low_mach == 1) then
5447
5448# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5449 if (riemann_solver == 1 .or. riemann_solver == 5) then
5450# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5451
5452# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5453 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5454# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5455 pcorr = 0._wp
5456# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5457
5458# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5459 if (low_mach == 1) then
5460# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5461 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5462# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5463 end if
5464# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5465
5466# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5467 else if (riemann_solver == 2) then
5468# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5469 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5470# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5471 pcorr = 0._wp
5472# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5473
5474# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5475 if (low_mach == 1) then
5476# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5477 pcorr = rho_l*rho_r* &
5478# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5479 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
5480# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5481 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
5482# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5483 (zcoef - 1._wp)
5484# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5485 else if (low_mach == 2) then
5486# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5487 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))))
5488# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5489 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))))
5490# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5491 vel_l(dir_idx(1)) = vel_l_tmp
5492# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5493 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
5498# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5499
5500 else
5501 pcorr = 0._wp
5502 end if
5503
5504 ! Mass
5505 if (.not. relativity) then
5506
5507# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5508#if defined(MFC_OpenACC)
5509# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5510!$acc loop seq
5511# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5512#elif defined(MFC_OpenMP)
5513# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5514
5515# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5516#endif
5517 do i = 1, contxe
5518 flux_rsy_vf(j, k, l, i) = &
5519 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
5520 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
5521 + s_m*s_p*(alpha_rho_l(i) &
5522 - alpha_rho_r(i))) &
5523 /(s_m - s_p)
5524 end do
5525 elseif (relativity) then
5526
5527# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5528#if defined(MFC_OpenACC)
5529# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5530!$acc loop seq
5531# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5532#elif defined(MFC_OpenMP)
5533# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5534
5535# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5536#endif
5537 do i = 1, contxe
5538 flux_rsy_vf(j, k, l, i) = &
5539 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
5540 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
5541 + s_m*s_p*(ga%L*alpha_rho_l(i) &
5542 - ga%R*alpha_rho_r(i))) &
5543 /(s_m - s_p)
5544 end do
5545 end if
5546
5547 ! Momentum
5548 if (mhd .and. (.not. relativity)) then
5549
5550# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5551#if defined(MFC_OpenACC)
5552# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5553!$acc loop seq
5554# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5555#elif defined(MFC_OpenMP)
5556# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5557
5558# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5559#endif
5560 do i = 1, 3
5561 ! Flux of rho*v_i in the y direction
5562 ! = rho * v_i * v_y - B_i * B_y + delta_(y,i) * p_tot
5563 flux_rsy_vf(j, k, l, contxe + i) = &
5564 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
5565 - b%R(i)*b%R(norm_dir) &
5566 + dir_flg(i)*(pres_r + pres_mag%R)) &
5567 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
5568 - b%L(i)*b%L(norm_dir) &
5569 + dir_flg(i)*(pres_l + pres_mag%L)) &
5570 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
5571 /(s_m - s_p)
5572 end do
5573 elseif (mhd .and. relativity) then
5574
5575# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5576#if defined(MFC_OpenACC)
5577# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5578!$acc loop seq
5579# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5580#elif defined(MFC_OpenMP)
5581# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5582
5583# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5584#endif
5585 do i = 1, 3
5586 ! Flux of m_i in the y direction
5587 ! = m_i * v_y - b_i/Gamma * B_y + delta_(y,i) * p_tot
5588 flux_rsy_vf(j, k, l, contxe + i) = &
5589 (s_m*(cm%R(i)*vel_r(norm_dir) &
5590 - b4%R(i)/ga%R*b%R(norm_dir) &
5591 + dir_flg(i)*(pres_r + pres_mag%R)) &
5592 - s_p*(cm%L(i)*vel_l(norm_dir) &
5593 - b4%L(i)/ga%L*b%L(norm_dir) &
5594 + dir_flg(i)*(pres_l + pres_mag%L)) &
5595 + s_m*s_p*(cm%L(i) - cm%R(i))) &
5596 /(s_m - s_p)
5597 end do
5598 elseif (bubbles_euler) then
5599
5600# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5601#if defined(MFC_OpenACC)
5602# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5603!$acc loop seq
5604# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5605#elif defined(MFC_OpenMP)
5606# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5607
5608# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5609#endif
5610 do i = 1, num_vels
5611 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
5612 (s_m*(rho_r*vel_r(dir_idx(1)) &
5613 *vel_r(dir_idx(i)) &
5614 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
5615 - s_p*(rho_l*vel_l(dir_idx(1)) &
5616 *vel_l(dir_idx(i)) &
5617 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
5618 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5619 - rho_r*vel_r(dir_idx(i)))) &
5620 /(s_m - s_p) &
5621 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5622 end do
5623 else if (hypoelasticity) then
5624
5625# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5626#if defined(MFC_OpenACC)
5627# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5628!$acc loop seq
5629# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5630#elif defined(MFC_OpenMP)
5631# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5632
5633# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5634#endif
5635 do i = 1, num_vels
5636 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
5637 (s_m*(rho_r*vel_r(dir_idx(1)) &
5638 *vel_r(dir_idx(i)) &
5639 + dir_flg(dir_idx(i))*pres_r &
5640 - tau_e_r(dir_idx_tau(i))) &
5641 - s_p*(rho_l*vel_l(dir_idx(1)) &
5642 *vel_l(dir_idx(i)) &
5643 + dir_flg(dir_idx(i))*pres_l &
5644 - tau_e_l(dir_idx_tau(i))) &
5645 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5646 - rho_r*vel_r(dir_idx(i)))) &
5647 /(s_m - s_p)
5648 end do
5649 else
5650
5651# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5652#if defined(MFC_OpenACC)
5653# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5654!$acc loop seq
5655# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5656#elif defined(MFC_OpenMP)
5657# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5658
5659# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5660#endif
5661 do i = 1, num_vels
5662 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
5663 (s_m*(rho_r*vel_r(dir_idx(1)) &
5664 *vel_r(dir_idx(i)) &
5665 + dir_flg(dir_idx(i))*pres_r) &
5666 - s_p*(rho_l*vel_l(dir_idx(1)) &
5667 *vel_l(dir_idx(i)) &
5668 + dir_flg(dir_idx(i))*pres_l) &
5669 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5670 - rho_r*vel_r(dir_idx(i)))) &
5671 /(s_m - s_p) &
5672 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5673 end do
5674 end if
5675
5676 ! Energy
5677 if (mhd .and. (.not. relativity)) then
5678 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
5679# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5680 flux_rsy_vf(j, k, l, e_idx) = &
5681 (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))) &
5682 - 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))) &
5683 + s_m*s_p*(e_l - e_r)) &
5684 /(s_m - s_p)
5685# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5686 elseif (mhd .and. relativity) then
5687 ! energy flux = m_y - mass flux
5688 ! Hard-coded for single-component for now
5689 flux_rsy_vf(j, k, l, e_idx) = &
5690 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5691 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
5692 + s_m*s_p*(e_l - e_r)) &
5693 /(s_m - s_p)
5694 else if (bubbles_euler) then
5695 flux_rsy_vf(j, k, l, e_idx) = &
5696 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
5697 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
5698 + s_m*s_p*(e_l - e_r)) &
5699 /(s_m - s_p) &
5700 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5701 else if (hypoelasticity) then
5702 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5703
5704# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5705#if defined(MFC_OpenACC)
5706# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5707!$acc loop seq
5708# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5709#elif defined(MFC_OpenMP)
5710# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5711
5712# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5713#endif
5714 do i = 1, num_dims
5715 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5716 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5717 end do
5718 flux_rsy_vf(j, k, l, e_idx) = &
5719 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5720 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
5721 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
5722 else
5723 flux_rsy_vf(j, k, l, e_idx) = &
5724 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
5725 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
5726 + s_m*s_p*(e_l - e_r)) &
5727 /(s_m - s_p) &
5728 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5729 end if
5730
5731 ! Elastic Stresses
5732 if (hypoelasticity) then
5733 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
5734 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
5735 (s_m*(rho_r*vel_r(dir_idx(1)) &
5736 *tau_e_r(i)) &
5737 - s_p*(rho_l*vel_l(dir_idx(1)) &
5738 *tau_e_l(i)) &
5739 + s_m*s_p*(rho_l*tau_e_l(i) &
5740 - rho_r*tau_e_r(i))) &
5741 /(s_m - s_p)
5742 end do
5743 end if
5744
5745 ! Advection
5746
5747# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5748#if defined(MFC_OpenACC)
5749# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5750!$acc loop seq
5751# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5752#elif defined(MFC_OpenMP)
5753# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5754
5755# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5756#endif
5757 do i = advxb, advxe
5758 flux_rsy_vf(j, k, l, i) = &
5759 (ql_prim_rsy_vf(j, k, l, i) &
5760 - qr_prim_rsy_vf(j + 1, k, l, i)) &
5761 *s_m*s_p/(s_m - s_p)
5762 flux_src_rsy_vf(j, k, l, i) = &
5763 (s_m*qr_prim_rsy_vf(j + 1, k, l, i) &
5764 - s_p*ql_prim_rsy_vf(j, k, l, i)) &
5765 /(s_m - s_p)
5766 end do
5767
5768 if (bubbles_euler) then
5769 ! From HLLC: Kills mass transport @ bubble gas density
5770 if (num_fluids > 1) then
5771 flux_rsy_vf(j, k, l, contxe) = 0._wp
5772 end if
5773 end if
5774
5775 if (chemistry) then
5776
5777# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5778#if defined(MFC_OpenACC)
5779# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5780!$acc loop seq
5781# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5782#elif defined(MFC_OpenMP)
5783# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5784
5785# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5786#endif
5787 do i = chemxb, chemxe
5788 y_l = ql_prim_rsy_vf(j, k, l, i)
5789 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
5790
5791 flux_rsy_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
5792 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5793 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
5794 /(s_m - s_p)
5795 flux_src_rsy_vf(j, k, l, i) = 0._wp
5796 end do
5797 end if
5798
5799 if (mhd) then
5800 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5801 ! B_y flux = v_x * B_y - v_y * Bx0
5802 ! B_z flux = v_x * B_z - v_z * Bx0
5803
5804# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5805#if defined(MFC_OpenACC)
5806# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5807!$acc loop seq
5808# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5809#elif defined(MFC_OpenMP)
5810# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5811
5812# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5813#endif
5814 do i = 0, 1
5815 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5816 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
5817 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
5818 end do
5819 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5820 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y)
5821 ! B_y d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y)
5822 ! B_z d/dy flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
5823
5824# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5825#if defined(MFC_OpenACC)
5826# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5827!$acc loop seq
5828# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5829#elif defined(MFC_OpenMP)
5830# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5831
5832# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5833#endif
5834 do i = 0, 2
5835 flux_rsy_vf(j, k, l, b_idx%beg + i) = (1 - dir_flg(i + 1))*( &
5836 s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
5837 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
5838 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5839 end do
5840 end if
5841 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
5842 end if
5843
5844# 1652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5845 if (cyl_coord) then
5846 !Substituting the advective flux into the inviscid geometrical source flux
5847
5848# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5849#if defined(MFC_OpenACC)
5850# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5851!$acc loop seq
5852# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5853#elif defined(MFC_OpenMP)
5854# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5855
5856# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5857#endif
5858 do i = 1, e_idx
5859 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5860 end do
5861 ! Recalculating the radial momentum geometric source flux
5862 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
5863 flux_rsy_vf(j, k, l, contxe + 2) &
5864 - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
5865 ! Geometrical source of the void fraction(s) is zero
5866
5867# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5868#if defined(MFC_OpenACC)
5869# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5870!$acc loop seq
5871# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5872#elif defined(MFC_OpenMP)
5873# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5874
5875# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5876#endif
5877 do i = advxb, advxe
5878 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5879 end do
5880 end if
5881
5882 if (cyl_coord .and. hypoelasticity) then
5883 ! += tau_sigmasigma using HLL
5884 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
5885 flux_gsrc_rsy_vf(j, k, l, contxe + 2) + &
5886 (s_m*tau_e_r(4) - s_p*tau_e_l(4)) &
5887 /(s_m - s_p)
5888
5889
5890# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5891#if defined(MFC_OpenACC)
5892# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5893!$acc loop seq
5894# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5895#elif defined(MFC_OpenMP)
5896# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5897
5898# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5899#endif
5900 do i = strxb, strxe
5901 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5902 end do
5903 end if
5904# 1682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5905 end do
5906 end do
5907 end do
5908
5909# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5910
5911# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5912#if defined(MFC_OpenACC)
5913# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5914!$acc end parallel loop
5915# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5916#elif defined(MFC_OpenMP)
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
5921# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5922!$omp end target teams loop
5923# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5924#endif
5925# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5926
5927 end if
5928
5929# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5930
5931 if (norm_dir == 3) then
5932
5933# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5934
5935# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5936#if defined(MFC_OpenACC)
5937# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5938!$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)
5939# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5940#elif defined(MFC_OpenMP)
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
5947# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5948!$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)
5949# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5950#endif
5951# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5952
5953 do l = is3%beg, is3%end
5954 do k = is2%beg, is2%end
5955 do j = is1%beg, is1%end
5956
5957# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5958#if defined(MFC_OpenACC)
5959# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5960!$acc loop seq
5961# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5962#elif defined(MFC_OpenMP)
5963# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5964
5965# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5966#endif
5967 do i = 1, contxe
5968 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
5969 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
5970 end do
5971
5972 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5973
5974
5975# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5976#if defined(MFC_OpenACC)
5977# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5978!$acc loop seq
5979# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5980#elif defined(MFC_OpenMP)
5981# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5982
5983# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5984#endif
5985 do i = 1, num_vels
5986 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
5987 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
5988 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5989 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5990 end do
5991
5992
5993# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5994#if defined(MFC_OpenACC)
5995# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5996!$acc loop seq
5997# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5998#elif defined(MFC_OpenMP)
5999# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6000
6001# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6002#endif
6003 do i = 1, num_fluids
6004 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
6005 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
6006 end do
6007
6008 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
6009 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
6010
6011 if (mhd) then
6012 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
6013 b%L(1) = bx0
6014 b%R(1) = bx0
6015 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
6016 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
6017 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
6018 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
6019 else ! 2D/3D: Bx, By, Bz as variables
6020 b%L(1) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
6021 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
6022 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
6023 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
6024 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 2)
6025 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 2)
6026 end if
6027 end if
6028
6029 rho_l = 0._wp
6030 gamma_l = 0._wp
6031 pi_inf_l = 0._wp
6032 qv_l = 0._wp
6033
6034 rho_r = 0._wp
6035 gamma_r = 0._wp
6036 pi_inf_r = 0._wp
6037 qv_r = 0._wp
6038
6039 alpha_l_sum = 0._wp
6040 alpha_r_sum = 0._wp
6041
6042 pres_mag%L = 0._wp
6043 pres_mag%R = 0._wp
6044
6045 if (mpp_lim) then
6046
6047# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6048#if defined(MFC_OpenACC)
6049# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6050!$acc loop seq
6051# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6052#elif defined(MFC_OpenMP)
6053# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6054
6055# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6056#endif
6057 do i = 1, num_fluids
6058 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
6059 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
6060 alpha_l_sum = alpha_l_sum + alpha_l(i)
6061 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
6062 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
6063 alpha_r_sum = alpha_r_sum + alpha_r(i)
6064 end do
6065
6066 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
6067 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
6068 end if
6069
6070
6071# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6072#if defined(MFC_OpenACC)
6073# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6074!$acc loop seq
6075# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6076#elif defined(MFC_OpenMP)
6077# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6078
6079# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6080#endif
6081 do i = 1, num_fluids
6082 rho_l = rho_l + alpha_rho_l(i)
6083 gamma_l = gamma_l + alpha_l(i)*gammas(i)
6084 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
6085 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
6086
6087 rho_r = rho_r + alpha_rho_r(i)
6088 gamma_r = gamma_r + alpha_r(i)*gammas(i)
6089 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
6090 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
6091 end do
6092
6093 if (viscous) then
6094
6095# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6096#if defined(MFC_OpenACC)
6097# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6098!$acc loop seq
6099# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6100#elif defined(MFC_OpenMP)
6101# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6102
6103# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6104#endif
6105 do i = 1, 2
6106 re_l(i) = dflt_real
6107 re_r(i) = dflt_real
6108
6109 if (re_size(i) > 0) re_l(i) = 0._wp
6110 if (re_size(i) > 0) re_r(i) = 0._wp
6111
6112
6113# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6114#if defined(MFC_OpenACC)
6115# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6116!$acc loop seq
6117# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6118#elif defined(MFC_OpenMP)
6119# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6120
6121# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6122#endif
6123 do q = 1, re_size(i)
6124 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
6125 + re_l(i)
6126 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
6127 + re_r(i)
6128 end do
6129
6130 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6131 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6132 end do
6133 end if
6134
6135 if (chemistry) then
6136
6137# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6138#if defined(MFC_OpenACC)
6139# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6140!$acc loop seq
6141# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6142#elif defined(MFC_OpenMP)
6143# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6144
6145# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6146#endif
6147 do i = chemxb, chemxe
6148 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
6149 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
6150 end do
6151
6152 call get_mixture_molecular_weight(ys_l, mw_l)
6153 call get_mixture_molecular_weight(ys_r, mw_r)
6154
6155# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6156 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
6157 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
6158# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6159
6160 r_gas_l = gas_constant/mw_l
6161 r_gas_r = gas_constant/mw_r
6162 t_l = pres_l/rho_l/r_gas_l
6163 t_r = pres_r/rho_r/r_gas_r
6164
6165 call get_species_specific_heats_r(t_l, cp_il)
6166 call get_species_specific_heats_r(t_r, cp_ir)
6167
6168 if (chem_params%gamma_method == 1) then
6169 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
6170 gamma_il = cp_il/(cp_il - 1.0_wp)
6171 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
6172
6173 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
6174 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
6175 else if (chem_params%gamma_method == 2) then
6176 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
6177 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
6178 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
6179 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
6180 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
6181
6182 gamm_l = cp_l/cv_l
6183 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
6184 gamm_r = cp_r/cv_r
6185 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
6186 end if
6187
6188 call get_mixture_energy_mass(t_l, ys_l, e_l)
6189 call get_mixture_energy_mass(t_r, ys_r, e_r)
6190
6191 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
6192 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
6193 h_l = (e_l + pres_l)/rho_l
6194 h_r = (e_r + pres_r)/rho_r
6195 elseif (mhd .and. relativity) then
6196# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6197 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
6198 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
6199 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
6200 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
6201
6202 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
6203 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
6204 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
6205 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
6206
6207 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
6208 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
6209
6210 ! Hard-coded EOS
6211 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
6212 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
6213
6214 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
6215 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
6216
6217 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
6218 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
6219# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6220 elseif (mhd .and. .not. relativity) then
6221 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
6222 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
6223 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
6224 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
6225 h_l = (e_l + pres_l - pres_mag%L)/rho_l
6226 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
6227 else
6228 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
6229 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
6230 h_l = (e_l + pres_l)/rho_l
6231 h_r = (e_r + pres_r)/rho_r
6232 end if
6233
6234 ! elastic energy update
6235 if (hypoelasticity) then
6236 g_l = 0._wp; g_r = 0._wp
6237
6238
6239# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6240#if defined(MFC_OpenACC)
6241# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6242!$acc loop seq
6243# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6244#elif defined(MFC_OpenMP)
6245# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6246
6247# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6248#endif
6249 do i = 1, num_fluids
6250 g_l = g_l + alpha_l(i)*gs_rs(i)
6251 g_r = g_r + alpha_r(i)*gs_rs(i)
6252 end do
6253
6254 if (cont_damage) then
6255 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
6256 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
6257 end if
6258
6259 do i = 1, strxe - strxb + 1
6260 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
6261 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
6262 ! Elastic contribution to energy if G large enough
6263 !TODO take out if statement if stable without
6264 if ((g_l > 1000) .and. (g_r > 1000)) then
6265 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6266 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6267 ! Double for shear stresses
6268 if (any(strxb - 1 + i == shear_indices)) then
6269 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6270 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6271 end if
6272 end if
6273 end do
6274 end if
6275
6276 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
6277 vel_l_rms, 0._wp, c_l, qv_l)
6278
6279 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
6280 vel_r_rms, 0._wp, c_r, qv_r)
6281
6282 if (mhd) then
6283 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
6284 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
6285 end if
6286
6287 s_l = 0._wp; s_r = 0._wp
6288
6289
6290# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6291#if defined(MFC_OpenACC)
6292# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6293!$acc loop seq
6294# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6295#elif defined(MFC_OpenMP)
6296# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6297
6298# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6299#endif
6300 do i = 1, num_dims
6301 s_l = s_l + vel_l(i)**2._wp
6302 s_r = s_r + vel_r(i)**2._wp
6303 end do
6304
6305 s_l = sqrt(s_l)
6306 s_r = sqrt(s_r)
6307
6308 s_p = max(s_l, s_r) + max(c_l, c_r)
6309 s_m = -s_p
6310
6311 s_l = s_m
6312 s_r = s_p
6313
6314 ! Low Mach correction
6315 if (low_mach == 1) then
6316
6317# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6318 if (riemann_solver == 1 .or. riemann_solver == 5) then
6319# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6320
6321# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6322 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6323# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6324 pcorr = 0._wp
6325# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6326
6327# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6328 if (low_mach == 1) then
6329# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6330 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6331# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6332 end if
6333# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6334
6335# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6336 else if (riemann_solver == 2) then
6337# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6338 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6339# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6340 pcorr = 0._wp
6341# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6342
6343# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6344 if (low_mach == 1) then
6345# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6346 pcorr = rho_l*rho_r* &
6347# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6348 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
6349# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6350 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
6351# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6352 (zcoef - 1._wp)
6353# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6354 else if (low_mach == 2) then
6355# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6356 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))))
6357# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6358 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))))
6359# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6360 vel_l(dir_idx(1)) = vel_l_tmp
6361# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6362 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
6367# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6368
6369 else
6370 pcorr = 0._wp
6371 end if
6372
6373 ! Mass
6374 if (.not. relativity) then
6375
6376# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6377#if defined(MFC_OpenACC)
6378# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6379!$acc loop seq
6380# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6381#elif defined(MFC_OpenMP)
6382# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6383
6384# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6385#endif
6386 do i = 1, contxe
6387 flux_rsz_vf(j, k, l, i) = &
6388 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
6389 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
6390 + s_m*s_p*(alpha_rho_l(i) &
6391 - alpha_rho_r(i))) &
6392 /(s_m - s_p)
6393 end do
6394 elseif (relativity) then
6395
6396# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6397#if defined(MFC_OpenACC)
6398# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6399!$acc loop seq
6400# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6401#elif defined(MFC_OpenMP)
6402# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6403
6404# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6405#endif
6406 do i = 1, contxe
6407 flux_rsz_vf(j, k, l, i) = &
6408 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
6409 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
6410 + s_m*s_p*(ga%L*alpha_rho_l(i) &
6411 - ga%R*alpha_rho_r(i))) &
6412 /(s_m - s_p)
6413 end do
6414 end if
6415
6416 ! Momentum
6417 if (mhd .and. (.not. relativity)) then
6418
6419# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6420#if defined(MFC_OpenACC)
6421# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6422!$acc loop seq
6423# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6424#elif defined(MFC_OpenMP)
6425# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6426
6427# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6428#endif
6429 do i = 1, 3
6430 ! Flux of rho*v_i in the z direction
6431 ! = rho * v_i * v_z - B_i * B_z + delta_(z,i) * p_tot
6432 flux_rsz_vf(j, k, l, contxe + i) = &
6433 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
6434 - b%R(i)*b%R(norm_dir) &
6435 + dir_flg(i)*(pres_r + pres_mag%R)) &
6436 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
6437 - b%L(i)*b%L(norm_dir) &
6438 + dir_flg(i)*(pres_l + pres_mag%L)) &
6439 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
6440 /(s_m - s_p)
6441 end do
6442 elseif (mhd .and. relativity) then
6443
6444# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6445#if defined(MFC_OpenACC)
6446# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6447!$acc loop seq
6448# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6449#elif defined(MFC_OpenMP)
6450# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6451
6452# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6453#endif
6454 do i = 1, 3
6455 ! Flux of m_i in the z direction
6456 ! = m_i * v_z - b_i/Gamma * B_z + delta_(z,i) * p_tot
6457 flux_rsz_vf(j, k, l, contxe + i) = &
6458 (s_m*(cm%R(i)*vel_r(norm_dir) &
6459 - b4%R(i)/ga%R*b%R(norm_dir) &
6460 + dir_flg(i)*(pres_r + pres_mag%R)) &
6461 - s_p*(cm%L(i)*vel_l(norm_dir) &
6462 - b4%L(i)/ga%L*b%L(norm_dir) &
6463 + dir_flg(i)*(pres_l + pres_mag%L)) &
6464 + s_m*s_p*(cm%L(i) - cm%R(i))) &
6465 /(s_m - s_p)
6466 end do
6467 elseif (bubbles_euler) then
6468
6469# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6470#if defined(MFC_OpenACC)
6471# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6472!$acc loop seq
6473# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6474#elif defined(MFC_OpenMP)
6475# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6476
6477# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6478#endif
6479 do i = 1, num_vels
6480 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
6481 (s_m*(rho_r*vel_r(dir_idx(1)) &
6482 *vel_r(dir_idx(i)) &
6483 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
6484 - s_p*(rho_l*vel_l(dir_idx(1)) &
6485 *vel_l(dir_idx(i)) &
6486 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
6487 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
6488 - rho_r*vel_r(dir_idx(i)))) &
6489 /(s_m - s_p) &
6490 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
6491 end do
6492 else if (hypoelasticity) then
6493
6494# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6495#if defined(MFC_OpenACC)
6496# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6497!$acc loop seq
6498# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6499#elif defined(MFC_OpenMP)
6500# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6501
6502# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6503#endif
6504 do i = 1, num_vels
6505 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
6506 (s_m*(rho_r*vel_r(dir_idx(1)) &
6507 *vel_r(dir_idx(i)) &
6508 + dir_flg(dir_idx(i))*pres_r &
6509 - tau_e_r(dir_idx_tau(i))) &
6510 - s_p*(rho_l*vel_l(dir_idx(1)) &
6511 *vel_l(dir_idx(i)) &
6512 + dir_flg(dir_idx(i))*pres_l &
6513 - tau_e_l(dir_idx_tau(i))) &
6514 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
6515 - rho_r*vel_r(dir_idx(i)))) &
6516 /(s_m - s_p)
6517 end do
6518 else
6519
6520# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6521#if defined(MFC_OpenACC)
6522# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6523!$acc loop seq
6524# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6525#elif defined(MFC_OpenMP)
6526# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6527
6528# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6529#endif
6530 do i = 1, num_vels
6531 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
6532 (s_m*(rho_r*vel_r(dir_idx(1)) &
6533 *vel_r(dir_idx(i)) &
6534 + dir_flg(dir_idx(i))*pres_r) &
6535 - s_p*(rho_l*vel_l(dir_idx(1)) &
6536 *vel_l(dir_idx(i)) &
6537 + dir_flg(dir_idx(i))*pres_l) &
6538 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
6539 - rho_r*vel_r(dir_idx(i)))) &
6540 /(s_m - s_p) &
6541 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
6542 end do
6543 end if
6544
6545 ! Energy
6546 if (mhd .and. (.not. relativity)) then
6547 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
6548# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6549 flux_rsz_vf(j, k, l, e_idx) = &
6550 (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))) &
6551 - 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))) &
6552 + s_m*s_p*(e_l - e_r)) &
6553 /(s_m - s_p)
6554# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6555 elseif (mhd .and. relativity) then
6556 ! energy flux = m_z - mass flux
6557 ! Hard-coded for single-component for now
6558 flux_rsz_vf(j, k, l, e_idx) = &
6559 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
6560 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
6561 + s_m*s_p*(e_l - e_r)) &
6562 /(s_m - s_p)
6563 else if (bubbles_euler) then
6564 flux_rsz_vf(j, k, l, e_idx) = &
6565 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
6566 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
6567 + s_m*s_p*(e_l - e_r)) &
6568 /(s_m - s_p) &
6569 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
6570 else if (hypoelasticity) then
6571 flux_tau_l = 0._wp; flux_tau_r = 0._wp
6572
6573# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6574#if defined(MFC_OpenACC)
6575# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6576!$acc loop seq
6577# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6578#elif defined(MFC_OpenMP)
6579# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6580
6581# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6582#endif
6583 do i = 1, num_dims
6584 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
6585 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
6586 end do
6587 flux_rsz_vf(j, k, l, e_idx) = &
6588 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
6589 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
6590 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
6591 else
6592 flux_rsz_vf(j, k, l, e_idx) = &
6593 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
6594 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
6595 + s_m*s_p*(e_l - e_r)) &
6596 /(s_m - s_p) &
6597 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
6598 end if
6599
6600 ! Elastic Stresses
6601 if (hypoelasticity) then
6602 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
6603 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
6604 (s_m*(rho_r*vel_r(dir_idx(1)) &
6605 *tau_e_r(i)) &
6606 - s_p*(rho_l*vel_l(dir_idx(1)) &
6607 *tau_e_l(i)) &
6608 + s_m*s_p*(rho_l*tau_e_l(i) &
6609 - rho_r*tau_e_r(i))) &
6610 /(s_m - s_p)
6611 end do
6612 end if
6613
6614 ! Advection
6615
6616# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6617#if defined(MFC_OpenACC)
6618# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6619!$acc loop seq
6620# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6621#elif defined(MFC_OpenMP)
6622# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6623
6624# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6625#endif
6626 do i = advxb, advxe
6627 flux_rsz_vf(j, k, l, i) = &
6628 (ql_prim_rsz_vf(j, k, l, i) &
6629 - qr_prim_rsz_vf(j + 1, k, l, i)) &
6630 *s_m*s_p/(s_m - s_p)
6631 flux_src_rsz_vf(j, k, l, i) = &
6632 (s_m*qr_prim_rsz_vf(j + 1, k, l, i) &
6633 - s_p*ql_prim_rsz_vf(j, k, l, i)) &
6634 /(s_m - s_p)
6635 end do
6636
6637 if (bubbles_euler) then
6638 ! From HLLC: Kills mass transport @ bubble gas density
6639 if (num_fluids > 1) then
6640 flux_rsz_vf(j, k, l, contxe) = 0._wp
6641 end if
6642 end if
6643
6644 if (chemistry) then
6645
6646# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6647#if defined(MFC_OpenACC)
6648# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6649!$acc loop seq
6650# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6651#elif defined(MFC_OpenMP)
6652# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6653
6654# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6655#endif
6656 do i = chemxb, chemxe
6657 y_l = ql_prim_rsz_vf(j, k, l, i)
6658 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
6659
6660 flux_rsz_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
6661 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
6662 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
6663 /(s_m - s_p)
6664 flux_src_rsz_vf(j, k, l, i) = 0._wp
6665 end do
6666 end if
6667
6668 if (mhd) then
6669 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
6670 ! B_y flux = v_x * B_y - v_y * Bx0
6671 ! B_z flux = v_x * B_z - v_z * Bx0
6672
6673# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6674#if defined(MFC_OpenACC)
6675# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6676!$acc loop seq
6677# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6678#elif defined(MFC_OpenMP)
6679# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6680
6681# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6682#endif
6683 do i = 0, 1
6684 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
6685 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
6686 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
6687 end do
6688 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
6689 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z)
6690 ! B_y d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z)
6691 ! B_z d/dz flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
6692
6693# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6694#if defined(MFC_OpenACC)
6695# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6696!$acc loop seq
6697# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6698#elif defined(MFC_OpenMP)
6699# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6700
6701# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6702#endif
6703 do i = 0, 2
6704 flux_rsz_vf(j, k, l, b_idx%beg + i) = (1 - dir_flg(i + 1))*( &
6705 s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
6706 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
6707 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
6708 end do
6709 end if
6710 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
6711 end if
6712
6713# 1682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6714 end do
6715 end do
6716 end do
6717
6718# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6719
6720# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6721#if defined(MFC_OpenACC)
6722# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6723!$acc end parallel loop
6724# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6725#elif defined(MFC_OpenMP)
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
6730# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6731!$omp end target teams loop
6732# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6733#endif
6734# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6735
6736 end if
6737
6738# 1689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6739
6740 if (viscous .or. dummy) then
6741
6742# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6743
6744# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6745#if defined(MFC_OpenACC)
6746# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6747!$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)
6748# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6749#elif defined(MFC_OpenMP)
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
6756# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6757!$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)
6758# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6759#endif
6760# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6761
6762 do l = isz%beg, isz%end
6763 do k = isy%beg, isy%end
6764 do j = isx%beg, isx%end
6765 idx_right_phys(1) = j
6766 idx_right_phys(2) = k
6767 idx_right_phys(3) = l
6768 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
6769
6770 if (norm_dir == 1) then
6771
6772# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6773#if defined(MFC_OpenACC)
6774# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6775!$acc loop seq
6776# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6777#elif defined(MFC_OpenMP)
6778# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6779
6780# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6781#endif
6782 do i = 1, num_fluids
6783 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
6784 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
6785 end do
6786
6787
6788# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6789#if defined(MFC_OpenACC)
6790# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6791!$acc loop seq
6792# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6793#elif defined(MFC_OpenMP)
6794# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6795
6796# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6797#endif
6798 do i = 1, num_dims
6799 vel_l(i) = ql_prim_rsx_vf(j, k, l, momxb + i - 1)
6800 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, momxb + i - 1)
6801 end do
6802 else if (norm_dir == 2) then
6803
6804# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6805#if defined(MFC_OpenACC)
6806# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6807!$acc loop seq
6808# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6809#elif defined(MFC_OpenMP)
6810# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6811
6812# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6813#endif
6814 do i = 1, num_fluids
6815 alpha_l(i) = ql_prim_rsy_vf(k, j, l, e_idx + i)
6816 alpha_r(i) = qr_prim_rsy_vf(k + 1, j, l, e_idx + i)
6817 end do
6818
6819# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6820#if defined(MFC_OpenACC)
6821# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6822!$acc loop seq
6823# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6824#elif defined(MFC_OpenMP)
6825# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6826
6827# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6828#endif
6829 do i = 1, num_dims
6830 vel_l(i) = ql_prim_rsy_vf(k, j, l, momxb + i - 1)
6831 vel_r(i) = qr_prim_rsy_vf(k + 1, j, l, momxb + i - 1)
6832 end do
6833 else
6834
6835# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6836#if defined(MFC_OpenACC)
6837# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6838!$acc loop seq
6839# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6840#elif defined(MFC_OpenMP)
6841# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6842
6843# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6844#endif
6845 do i = 1, num_fluids
6846 alpha_l(i) = ql_prim_rsz_vf(l, k, j, e_idx + i)
6847 alpha_r(i) = qr_prim_rsz_vf(l + 1, k, j, e_idx + i)
6848 end do
6849
6850
6851# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6852#if defined(MFC_OpenACC)
6853# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6854!$acc loop seq
6855# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6856#elif defined(MFC_OpenMP)
6857# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6858
6859# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6860#endif
6861 do i = 1, num_dims
6862 vel_l(i) = ql_prim_rsz_vf(l, k, j, momxb + i - 1)
6863 vel_r(i) = qr_prim_rsz_vf(l + 1, k, j, momxb + i - 1)
6864 end do
6865 end if
6866
6867
6868# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6869#if defined(MFC_OpenACC)
6870# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6871!$acc loop seq
6872# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6873#elif defined(MFC_OpenMP)
6874# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6875
6876# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6877#endif
6878 do i = 1, 2
6879 re_l(i) = dflt_real
6880 re_r(i) = dflt_real
6881
6882 if (re_size(i) > 0) re_l(i) = 0._wp
6883 if (re_size(i) > 0) re_r(i) = 0._wp
6884
6885
6886# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6887#if defined(MFC_OpenACC)
6888# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6889!$acc loop seq
6890# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6891#elif defined(MFC_OpenMP)
6892# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6893
6894# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6895#endif
6896 do q = 1, re_size(i)
6897 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
6898 + re_l(i)
6899 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
6900 + re_r(i)
6901 end do
6902
6903 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6904 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6905 end do
6906
6907 if (shear_stress) then
6908
6909
6910# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6911#if defined(MFC_OpenACC)
6912# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6913!$acc loop seq
6914# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6915#elif defined(MFC_OpenMP)
6916# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6917
6918# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6919#endif
6920 do i = 1, num_dims
6921 vel_grad_l(i, 1) = (dql_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6922 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))
6923# 1764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6924 if (num_dims > 1) then
6925 vel_grad_l(i, 2) = (dql_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6926 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))
6927 end if
6928# 1769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6929 if (num_dims > 2) then
6930 vel_grad_l(i, 3) = (dql_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6931 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))
6932 end if
6933# 1774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6934# 1775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6935 end do
6936
6937 if (norm_dir == 1) then
6938 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))
6939 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))
6940# 1781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6941 if (num_dims > 1) then
6942 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))
6943 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))
6944
6945 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))
6946 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))
6947# 1788 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6948 if (num_dims > 2) then
6949 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))
6950 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))
6951
6952 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))
6953 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))
6954 end if
6955# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6956 end if
6957# 1798 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6958
6959 else if (norm_dir == 2) then
6960# 1801 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6961 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))
6962 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))
6963
6964 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))
6965 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))
6966
6967 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))
6968 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))
6969# 1810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6970 if (num_dims > 2) then
6971 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))
6972 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))
6973
6974 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))
6975 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))
6976 end if
6977# 1818 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6978# 1819 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6979 else
6980# 1821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6981 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))
6982 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))
6983
6984 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))
6985 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))
6986
6987 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))
6988 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))
6989
6990 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))
6991 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))
6992
6993 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))
6994 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))
6995# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6996 end if
6997 end if
6998
6999 if (bulk_stress) then
7000
7001
7002# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7003#if defined(MFC_OpenACC)
7004# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7005!$acc loop seq
7006# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7007#elif defined(MFC_OpenMP)
7008# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7009
7010# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7011#endif
7012 do i = 1, num_dims
7013 vel_grad_l(i, 1) = (dql_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
7014 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))
7015# 1846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7016 if (num_dims > 1) then
7017 vel_grad_l(i, 2) = (dql_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
7018 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))
7019 end if
7020# 1851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7021# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7022 if (num_dims > 2) then
7023 vel_grad_l(i, 3) = (dql_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
7024 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))
7025 end if
7026# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7027 end do
7028
7029 if (norm_dir == 1) then
7030 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))
7031 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))
7032# 1863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7033 if (num_dims > 1) then
7034 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))
7035 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))
7036
7037# 1868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7038 if (num_dims > 2) then
7039 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))
7040 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))
7041 end if
7042# 1873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7043 end if
7044# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7045
7046 else if (norm_dir == 2) then
7047# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7048 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))
7049 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))
7050
7051 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))
7052 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))
7053
7054# 1885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7055 if (num_dims > 2) then
7056 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))
7057 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))
7058 end if
7059# 1890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7060# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7061 else
7062# 1893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7063 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))
7064 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))
7065
7066 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))
7067 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))
7068
7069 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))
7070 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))
7071# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7072 end if
7073
7074 end if
7075 end do
7076 end do
7077 end do
7078
7079# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7080
7081# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7082#if defined(MFC_OpenACC)
7083# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7084!$acc end parallel loop
7085# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7086#elif defined(MFC_OpenMP)
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
7091# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7092!$omp end target teams loop
7093# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7094#endif
7095# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7096
7097
7098 end if
7099
7100 call s_finalize_riemann_solver(flux_vf, flux_src_vf, &
7101 flux_gsrc_vf, &
7102 norm_dir)
7103
7104 end subroutine s_lf_riemann_solver
7105
7106 !> This procedure is the implementation of the Harten, Lax,
7107 !! van Leer, and contact (HLLC) approximate Riemann solver,
7108 !! see Toro (1999) and Johnsen (2007). The viscous and the
7109 !! surface tension effects have been included by modifying
7110 !! the exact Riemann solver of Perigaud and Saurel (2005).
7111 !! @param qL_prim_rsx_vf Left WENO-reconstructed cell-boundary values (x-dir)
7112 !! @param qL_prim_rsy_vf Left WENO-reconstructed cell-boundary values (y-dir)
7113 !! @param qL_prim_rsz_vf Left WENO-reconstructed cell-boundary values (z-dir)
7114 !! @param dqL_prim_dx_vf The left WENO-reconstructed cell-boundary values of the
7115 !! first-order x-dir spatial derivatives
7116 !! @param dqL_prim_dy_vf The left WENO-reconstructed cell-boundary values of the
7117 !! first-order y-dir spatial derivatives
7118 !! @param dqL_prim_dz_vf The left WENO-reconstructed cell-boundary values of the
7119 !! first-order z-dir spatial derivatives
7120 !! @param qL_prim_vf The left WENO-reconstructed cell-boundary values of the
7121 !! cell-average primitive variables
7122 !! @param qR_prim_rsx_vf Right WENO-reconstructed cell-boundary values (x-dir)
7123 !! @param qR_prim_rsy_vf Right WENO-reconstructed cell-boundary values (y-dir)
7124 !! @param qR_prim_rsz_vf Right WENO-reconstructed cell-boundary values (z-dir)
7125 !! @param dqR_prim_dx_vf The right WENO-reconstructed cell-boundary values of the
7126 !! first-order x-dir spatial derivatives
7127 !! @param dqR_prim_dy_vf The right WENO-reconstructed cell-boundary values of the
7128 !! first-order y-dir spatial derivatives
7129 !! @param dqR_prim_dz_vf The right WENO-reconstructed cell-boundary values of the
7130 !! first-order z-dir spatial derivatives
7131 !! @param qR_prim_vf The right WENO-reconstructed cell-boundary values of the
7132 !! cell-average primitive variables
7133 !! @param q_prim_vf Cell-averaged primitive variables
7134 !! @param flux_vf Intra-cell fluxes
7135 !! @param flux_src_vf Intra-cell fluxes sources
7136 !! @param flux_gsrc_vf Intra-cell geometric fluxes sources
7137 !! @param norm_dir Dir. splitting direction
7138 !! @param ix Index bounds in the x-dir
7139 !! @param iy Index bounds in the y-dir
7140 !! @param iz Index bounds in the z-dir
7141 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
7142 dqL_prim_dy_vf, &
7143 dqL_prim_dz_vf, &
7144 qL_prim_vf, &
7145 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
7146 dqR_prim_dy_vf, &
7147 dqR_prim_dz_vf, &
7148 qR_prim_vf, &
7149 q_prim_vf, &
7150 flux_vf, flux_src_vf, &
7151 flux_gsrc_vf, &
7152 norm_dir, ix, iy, iz)
7153
7154 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
7155 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
7156 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
7157
7158 type(scalar_field), &
7159 allocatable, dimension(:), &
7160 intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
7161 dql_prim_dy_vf, dqr_prim_dy_vf, &
7162 dql_prim_dz_vf, dqr_prim_dz_vf
7163
7164 ! Intercell fluxes
7165 type(scalar_field), &
7166 dimension(sys_size), &
7167 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
7168
7169 integer, intent(in) :: norm_dir
7170 type(int_bounds_info), intent(in) :: ix, iy, iz
7171
7172# 1989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7173 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
7174 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
7175 real(wp), dimension(num_dims) :: vel_l, vel_r
7176# 1993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7177
7178 real(wp) :: rho_l, rho_r
7179 real(wp) :: pres_l, pres_r
7180 real(wp) :: e_l, e_r
7181 real(wp) :: h_l, h_r
7182# 2002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7183 real(wp), dimension(num_species) :: ys_l, ys_r, xs_l, xs_r, gamma_il, gamma_ir, cp_il, cp_ir
7184 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
7185# 2005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7186 real(wp) :: cp_avg, cv_avg, t_avg, c_sum_yi_phi, eps
7187 real(wp) :: t_l, t_r
7188 real(wp) :: mw_l, mw_r
7189 real(wp) :: r_gas_l, r_gas_r
7190 real(wp) :: cp_l, cp_r
7191 real(wp) :: cv_l, cv_r
7192 real(wp) :: gamm_l, gamm_r
7193 real(wp) :: y_l, y_r
7194 real(wp) :: gamma_l, gamma_r
7195 real(wp) :: pi_inf_l, pi_inf_r
7196 real(wp) :: qv_l, qv_r
7197 real(wp) :: c_l, c_r
7198 real(wp), dimension(2) :: re_l, re_r
7199
7200 real(wp) :: rho_avg
7201 real(wp) :: h_avg
7202 real(wp) :: gamma_avg
7203 real(wp) :: qv_avg
7204 real(wp) :: c_avg
7205
7206 real(wp) :: s_l, s_r, s_m, s_p, s_s
7207 real(wp) :: xi_l, xi_r !< Left and right wave speeds functions
7208 real(wp) :: xi_m, xi_p
7209 real(wp) :: xi_mp, xi_pp
7210# 2035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7211 real(wp), dimension(nb) :: r0_l, r0_r
7212 real(wp), dimension(nb) :: v0_l, v0_r
7213 real(wp), dimension(nb) :: p0_l, p0_r
7214 real(wp), dimension(nb) :: pbw_l, pbw_r
7215# 2040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7216
7217 real(wp) :: alpha_l_sum, alpha_r_sum, nbub_l, nbub_r
7218 real(wp) :: ptilde_l, ptilde_r
7219
7220 real(wp) :: pbwr3lbar, pbwr3rbar
7221 real(wp) :: r3lbar, r3rbar
7222 real(wp) :: r3v2lbar, r3v2rbar
7223
7224 real(wp), dimension(6) :: tau_e_l, tau_e_r
7225# 2052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7226 real(wp), dimension(num_dims) :: xi_field_l, xi_field_r
7227# 2054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7228 real(wp) :: g_l, g_r
7229
7230 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
7231 real(wp) :: vel_l_tmp, vel_r_tmp
7232 real(wp) :: rho_star, e_star, p_star, p_k_star, vel_k_star
7233 real(wp) :: pres_sl, pres_sr, ms_l, ms_r
7234 real(wp) :: flux_ene_e
7235 real(wp) :: zcoef, pcorr !< low Mach number correction
7236
7237 integer :: re_max, i, j, k, l, q !< Generic loop iterators
7238
7239 ! Populating the buffers of the left and right Riemann problem
7240 ! states variables, based on the choice of boundary conditions
7241
7242 call s_populate_riemann_states_variables_buffers( &
7243 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
7244 dql_prim_dy_vf, &
7245 dql_prim_dz_vf, &
7246 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
7247 dqr_prim_dy_vf, &
7248 dqr_prim_dz_vf, &
7249 norm_dir, ix, iy, iz)
7250
7251 ! Reshaping inputted data based on dimensional splitting direction
7252
7253 call s_initialize_riemann_solver( &
7254 flux_src_vf, &
7255 norm_dir)
7256
7257# 2084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7258
7259 if (norm_dir == 1) then
7260
7261 ! 6-EQUATION MODEL WITH HLLC
7262 if (model_eqns == 3) then
7263 !ME3
7264
7265# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7266
7267# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7268#if defined(MFC_OpenACC)
7269# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7270!$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)
7271# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7272#elif defined(MFC_OpenMP)
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
7279# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7280!$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)
7281# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7282#endif
7283# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7284
7285 do l = is3%beg, is3%end
7286 do k = is2%beg, is2%end
7287 do j = is1%beg, is1%end
7288
7289 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7290 rho_l = 0._wp; rho_r = 0._wp
7291 gamma_l = 0._wp; gamma_r = 0._wp
7292 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7293 qv_l = 0._wp; qv_r = 0._wp
7294 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
7295
7296
7297# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7298#if defined(MFC_OpenACC)
7299# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7300!$acc loop seq
7301# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7302#elif defined(MFC_OpenMP)
7303# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7304
7305# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7306#endif
7307 do i = 1, num_dims
7308 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
7309 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
7310 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7311 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7312 end do
7313
7314 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
7315 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
7316
7317 rho_l = 0._wp
7318 gamma_l = 0._wp
7319 pi_inf_l = 0._wp
7320 qv_l = 0._wp
7321
7322 rho_r = 0._wp
7323 gamma_r = 0._wp
7324 pi_inf_r = 0._wp
7325 qv_r = 0._wp
7326
7327 alpha_l_sum = 0._wp
7328 alpha_r_sum = 0._wp
7329
7330 if (mpp_lim) then
7331
7332# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7333#if defined(MFC_OpenACC)
7334# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7335!$acc loop seq
7336# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7337#elif defined(MFC_OpenMP)
7338# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7339
7340# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7341#endif
7342 do i = 1, num_fluids
7343 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
7344 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)
7345 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, e_idx + i)
7346 end do
7347
7348
7349# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7350#if defined(MFC_OpenACC)
7351# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7352!$acc loop seq
7353# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7354#elif defined(MFC_OpenMP)
7355# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7356
7357# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7358#endif
7359 do i = 1, num_fluids
7360 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
7361 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)
7362 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
7363 end do
7364
7365
7366# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7367#if defined(MFC_OpenACC)
7368# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7369!$acc loop seq
7370# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7371#elif defined(MFC_OpenMP)
7372# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7373
7374# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7375#endif
7376 do i = 1, num_fluids
7377 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)
7378 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)
7379 end do
7380 end if
7381
7382
7383# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7384#if defined(MFC_OpenACC)
7385# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7386!$acc loop seq
7387# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7388#elif defined(MFC_OpenMP)
7389# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7390
7391# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7392#endif
7393 do i = 1, num_fluids
7394 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7395 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
7396 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
7397 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7398
7399 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7400 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
7401 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
7402 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7403
7404 alpha_l(i) = ql_prim_rsx_vf(j, k, l, advxb + i - 1)
7405 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, advxb + i - 1)
7406 end do
7407
7408 if (viscous) then
7409
7410# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7411#if defined(MFC_OpenACC)
7412# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7413!$acc loop seq
7414# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7415#elif defined(MFC_OpenMP)
7416# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7417
7418# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7419#endif
7420 do i = 1, 2
7421 re_l(i) = dflt_real
7422 re_r(i) = dflt_real
7423 if (re_size(i) > 0) re_l(i) = 0._wp
7424 if (re_size(i) > 0) re_r(i) = 0._wp
7425
7426# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7427#if defined(MFC_OpenACC)
7428# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7429!$acc loop seq
7430# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7431#elif defined(MFC_OpenMP)
7432# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7433
7434# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7435#endif
7436 do q = 1, re_size(i)
7437 re_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
7438 + re_l(i)
7439 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
7440 + re_r(i)
7441 end do
7442 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7443 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7444 end do
7445 end if
7446
7447 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7448 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7449
7450 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
7451 if (hypoelasticity) then
7452
7453# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7454#if defined(MFC_OpenACC)
7455# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7456!$acc loop seq
7457# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7458#elif defined(MFC_OpenMP)
7459# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7460
7461# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7462#endif
7463 do i = 1, strxe - strxb + 1
7464 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
7465 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
7466 end do
7467 g_l = 0._wp; g_r = 0._wp
7468
7469# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7470#if defined(MFC_OpenACC)
7471# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7472!$acc loop seq
7473# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7474#elif defined(MFC_OpenMP)
7475# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7476
7477# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7478#endif
7479 do i = 1, num_fluids
7480 g_l = g_l + alpha_l(i)*gs_rs(i)
7481 g_r = g_r + alpha_r(i)*gs_rs(i)
7482 end do
7483
7484# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7485#if defined(MFC_OpenACC)
7486# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7487!$acc loop seq
7488# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7489#elif defined(MFC_OpenMP)
7490# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7491
7492# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7493#endif
7494 do i = 1, strxe - strxb + 1
7495 ! Elastic contribution to energy if G large enough
7496 if ((g_l > verysmall) .and. (g_r > verysmall)) then
7497 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
7498 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
7499 ! Additional terms in 2D and 3D
7500 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
7501 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
7502 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
7503 end if
7504 end if
7505 end do
7506 end if
7507
7508 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
7509 if (hyperelasticity) then
7510
7511# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7512#if defined(MFC_OpenACC)
7513# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7514!$acc loop seq
7515# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7516#elif defined(MFC_OpenMP)
7517# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7518
7519# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7520#endif
7521 do i = 1, num_dims
7522 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, xibeg - 1 + i)
7523 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
7524 end do
7525 g_l = 0._wp; g_r = 0._wp;
7526
7527# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7528#if defined(MFC_OpenACC)
7529# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7530!$acc loop seq
7531# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7532#elif defined(MFC_OpenMP)
7533# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7534
7535# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7536#endif
7537 do i = 1, num_fluids
7538 ! Mixture left and right shear modulus
7539 g_l = g_l + alpha_l(i)*gs_rs(i)
7540 g_r = g_r + alpha_r(i)*gs_rs(i)
7541 end do
7542 ! Elastic contribution to energy if G large enough
7543 if (g_l > verysmall .and. g_r > verysmall) then
7544 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, xiend + 1)
7545 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, xiend + 1)
7546 end if
7547
7548# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7549#if defined(MFC_OpenACC)
7550# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7551!$acc loop seq
7552# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7553#elif defined(MFC_OpenMP)
7554# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7555
7556# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7557#endif
7558 do i = 1, b_size - 1
7559 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
7560 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
7561 end do
7562 end if
7563
7564 h_l = (e_l + pres_l)/rho_l
7565 h_r = (e_r + pres_r)/rho_r
7566
7567
7568# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7569 if (avg_state == 1) then
7570# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7571
7572# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7573 rho_avg = sqrt(rho_l*rho_r)
7574# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7575
7576# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7577 vel_avg_rms = 0._wp
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
7582# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7583#if defined(MFC_OpenACC)
7584# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7585!$acc loop seq
7586# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7587#elif defined(MFC_OpenMP)
7588# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7589
7590# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7591#endif
7592# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7593 do i = 1, num_vels
7594# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7595 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
7596# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7597 (sqrt(rho_l) + sqrt(rho_r))**2._wp
7598# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7599 end do
7600# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7601
7602# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7603 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
7604# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7605 (sqrt(rho_l) + sqrt(rho_r))
7606# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7607
7608# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7609 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
7610# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7611 (sqrt(rho_l) + sqrt(rho_r))
7612# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7613
7614# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7615 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
7616# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7617 (sqrt(rho_l) + sqrt(rho_r))**2._wp
7618# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7619
7620# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7621 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
7622# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7623 (sqrt(rho_l) + sqrt(rho_r))
7624# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7625
7626# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7627 if (chemistry) then
7628# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7629 eps = 0.001_wp
7630# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7631 call get_species_enthalpies_rt(t_l, h_il)
7632# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7633 call get_species_enthalpies_rt(t_r, h_ir)
7634# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7635 h_il = h_il*gas_constant/molecular_weights*t_l
7636# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7637 h_ir = h_ir*gas_constant/molecular_weights*t_r
7638# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7639 call get_species_specific_heats_r(t_l, cp_il)
7640# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7641 call get_species_specific_heats_r(t_r, cp_ir)
7642# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7643
7644# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7645 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7646# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7647 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7648# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7649 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7650# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7651 if (abs(t_l - t_r) < eps) then
7652# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7653 ! Case when T_L and T_R are very close
7654# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7655 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7656# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7657 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
7658# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7659 else
7660# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7661 ! Normal calculation when T_L and T_R are sufficiently different
7662# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7663 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7664# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7665 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7666# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7667 end if
7668# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7669 gamma_avg = cp_avg/cv_avg
7670# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7671
7672# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7673 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7674# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7675 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7676# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7677
7678# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7679 end if
7680# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7681
7682# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7683 end if
7684# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7685
7686# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7687 if (avg_state == 2) then
7688# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7689 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7690# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7691 vel_avg_rms = 0._wp
7692# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7693
7694# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7695#if defined(MFC_OpenACC)
7696# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7697!$acc loop seq
7698# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7699#elif defined(MFC_OpenMP)
7700# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7701
7702# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7703#endif
7704# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7705 do i = 1, num_vels
7706# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7707 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7708# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7709 end do
7710# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7711
7712# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7713 h_avg = 5.e-1_wp*(h_l + h_r)
7714# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7715 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7716# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7717 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7718# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7719
7720# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7721 end if
7722# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7723
7724
7725 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
7726 vel_l_rms, 0._wp, c_l, qv_l)
7727
7728 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
7729 vel_r_rms, 0._wp, c_r, qv_r)
7730
7731 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7732 ! variables are placeholders to call the subroutine.
7733 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
7734 vel_avg_rms, 0._wp, c_avg, qv_avg)
7735
7736 if (viscous) then
7737
7738# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7739#if defined(MFC_OpenACC)
7740# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7741!$acc loop seq
7742# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7743#elif defined(MFC_OpenMP)
7744# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7745
7746# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7747#endif
7748 do i = 1, 2
7749 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7750 end do
7751 end if
7752
7753 ! Low Mach correction
7754 if (low_mach == 2) then
7755
7756# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7757 if (riemann_solver == 1 .or. riemann_solver == 5) then
7758# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7759
7760# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7761 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7762# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7763 pcorr = 0._wp
7764# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7765
7766# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7767 if (low_mach == 1) then
7768# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7769 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7770# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7771 end if
7772# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7773
7774# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7775 else if (riemann_solver == 2) then
7776# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7777 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7778# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7779 pcorr = 0._wp
7780# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7781
7782# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7783 if (low_mach == 1) then
7784# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7785 pcorr = rho_l*rho_r* &
7786# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7787 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
7788# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7789 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
7790# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7791 (zcoef - 1._wp)
7792# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7793 else if (low_mach == 2) then
7794# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7795 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))))
7796# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7797 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))))
7798# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7799 vel_l(dir_idx(1)) = vel_l_tmp
7800# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7801 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
7806# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7807
7808 end if
7809
7810 ! COMPUTING THE DIRECT WAVE SPEEDS
7811 if (wave_speeds == 1) then
7812 if (elasticity) then
7813 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
7814 (((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 + &
7815 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
7816 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
7817 (((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 + &
7818 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
7819 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
7820 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
7821 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
7822 rho_r*(s_r - vel_r(dir_idx(1))))
7823 else
7824 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7825 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7826 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
7827 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
7828 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7829
7830 end if
7831 elseif (wave_speeds == 2) then
7832 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
7833 (vel_l(dir_idx(1)) - &
7834 vel_r(dir_idx(1))))
7835
7836 pres_sr = pres_sl
7837
7838 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
7839 (pres_sl/pres_l - 1._wp)*pres_l/ &
7840 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7841 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
7842 (pres_sr/pres_r - 1._wp)*pres_r/ &
7843 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7844
7845 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7846 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7847
7848 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
7849 (pres_l - pres_r)/ &
7850 (rho_avg*c_avg))
7851 end if
7852
7853 ! follows Einfeldt et al.
7854 ! s_M/P = min/max(0.,s_L/R)
7855 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7856
7857 ! goes with q_star_L/R = xi_L/R * (variable)
7858 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7859 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
7860 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
7861
7862 ! goes with numerical star velocity in x/y/z directions
7863 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
7864 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7865 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7866
7867 ! goes with the numerical velocity in x/y/z directions
7868 ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7869 xi_mp = -min(0._wp, sign(1._wp, s_l))
7870 xi_pp = max(0._wp, sign(1._wp, s_r))
7871
7872 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
7873 (rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) + &
7874 xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
7875 (rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7876 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) + &
7877 xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7878
7879 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + &
7880 xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
7881
7882 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + &
7883 xi_mp*xi_pp*(s_s - vel_r(dir_idx(1)))
7884
7885 ! Low Mach correction
7886 if (low_mach == 1) then
7887
7888# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7889 if (riemann_solver == 1 .or. riemann_solver == 5) then
7890# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7891
7892# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7893 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7894# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7895 pcorr = 0._wp
7896# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7897
7898# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7899 if (low_mach == 1) then
7900# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7901 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7902# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7903 end if
7904# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7905
7906# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7907 else if (riemann_solver == 2) then
7908# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7909 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7910# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7911 pcorr = 0._wp
7912# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7913
7914# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7915 if (low_mach == 1) then
7916# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7917 pcorr = rho_l*rho_r* &
7918# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7919 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
7920# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7921 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
7922# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7923 (zcoef - 1._wp)
7924# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7925 else if (low_mach == 2) then
7926# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7927 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))))
7928# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7929 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))))
7930# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7931 vel_l(dir_idx(1)) = vel_l_tmp
7932# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7933 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
7938# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7939
7940 else
7941 pcorr = 0._wp
7942 end if
7943
7944 ! COMPUTING FLUXES
7945 ! MASS FLUX.
7946
7947# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7948#if defined(MFC_OpenACC)
7949# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7950!$acc loop seq
7951# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7952#elif defined(MFC_OpenMP)
7953# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7954
7955# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7956#endif
7957 do i = 1, contxe
7958 flux_rsx_vf(j, k, l, i) = &
7959 xi_m*ql_prim_rsx_vf(j, k, l, i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + &
7960 xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7961 end do
7962
7963 ! MOMENTUM FLUX.
7964 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7965
7966# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7967#if defined(MFC_OpenACC)
7968# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7969!$acc loop seq
7970# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7971#elif defined(MFC_OpenMP)
7972# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7973
7974# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7975#endif
7976 do i = 1, num_dims
7977 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = rho_star*vel_k_star* &
7978 (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 &
7979 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7980 end do
7981
7982 ! ENERGY FLUX.
7983 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7984 flux_rsx_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star &
7985 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7986
7987 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7988 if (elasticity) then
7989 flux_ene_e = 0._wp;
7990
7991# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7992#if defined(MFC_OpenACC)
7993# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7994!$acc loop seq
7995# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7996#elif defined(MFC_OpenMP)
7997# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7998
7999# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8000#endif
8001 do i = 1, num_dims
8002 ! MOMENTUM ELASTIC FLUX.
8003 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
8004 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) &
8005 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
8006 ! ENERGY ELASTIC FLUX.
8007 flux_ene_e = flux_ene_e - &
8008 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
8009 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
8010 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
8011 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
8012 end do
8013 flux_rsx_vf(j, k, l, e_idx) = flux_rsx_vf(j, k, l, e_idx) + flux_ene_e
8014 end if
8015
8016 ! VOLUME FRACTION FLUX.
8017
8018# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8019#if defined(MFC_OpenACC)
8020# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8021!$acc loop seq
8022# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8023#elif defined(MFC_OpenMP)
8024# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8025
8026# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8027#endif
8028 do i = advxb, advxe
8029 flux_rsx_vf(j, k, l, i) = &
8030 xi_m*ql_prim_rsx_vf(j, k, l, i)*s_s + &
8031 xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
8032 end do
8033
8034 ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX.
8035
8036# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8037#if defined(MFC_OpenACC)
8038# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8039!$acc loop seq
8040# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8041#elif defined(MFC_OpenMP)
8042# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8043
8044# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8045#endif
8046 do i = 1, num_dims
8047 vel_src_rsx_vf(j, k, l, dir_idx(i)) = &
8048 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)))) + &
8049 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))))
8050 end do
8051
8052 ! INTERNAL ENERGIES ADVECTION FLUX.
8053 ! K-th pressure and velocity in preparation for the internal energy flux
8054
8055# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8056#if defined(MFC_OpenACC)
8057# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8058!$acc loop seq
8059# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8060#elif defined(MFC_OpenMP)
8061# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8062
8063# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8064#endif
8065 do i = 1, num_fluids
8066 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))* &
8067 xi_l**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) + &
8068 xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i)))* &
8069 xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) + pres_r)
8070
8071 flux_rsx_vf(j, k, l, i + intxb - 1) = &
8072 ((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))* &
8073 (gammas(i)*p_k_star + pi_infs(i)) + &
8074 (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))* &
8075 qvs(i))*vel_k_star &
8076 + (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))
8077 end do
8078
8079 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8080
8081 ! HYPOELASTIC STRESS EVOLUTION FLUX.
8082 if (hypoelasticity) then
8083
8084# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8085#if defined(MFC_OpenACC)
8086# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8087!$acc loop seq
8088# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8089#elif defined(MFC_OpenMP)
8090# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8091
8092# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8093#endif
8094 do i = 1, strxe - strxb + 1
8095 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
8096 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)) + &
8097 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))
8098 end do
8099 end if
8100
8101 ! REFERENCE MAP FLUX.
8102 if (hyperelasticity) then
8103
8104# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8105#if defined(MFC_OpenACC)
8106# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8107!$acc loop seq
8108# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8109#elif defined(MFC_OpenMP)
8110# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8111
8112# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8113#endif
8114 do i = 1, num_dims
8115 flux_rsx_vf(j, k, l, xibeg - 1 + i) = &
8116 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
8117 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
8118 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
8119 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
8120 end do
8121 end if
8122
8123 ! COLOR FUNCTION FLUX
8124 if (surface_tension) then
8125 flux_rsx_vf(j, k, l, c_idx) = &
8126 (xi_m*ql_prim_rsx_vf(j, k, l, c_idx) + &
8127 xi_p*qr_prim_rsx_vf(j + 1, k, l, c_idx))*s_s
8128 end if
8129
8130 ! Geometrical source flux for cylindrical coordinates
8131# 2478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8132# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8133
8134 end do
8135 end do
8136 end do
8137
8138# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8139
8140# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8141#if defined(MFC_OpenACC)
8142# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8143!$acc end parallel loop
8144# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8145#elif defined(MFC_OpenMP)
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
8150# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8151!$omp end target teams loop
8152# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8153#endif
8154# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8155
8156
8157 elseif (model_eqns == 4) then
8158 !ME4
8159
8160# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8161
8162# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8163#if defined(MFC_OpenACC)
8164# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8165!$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)
8166# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8167#elif defined(MFC_OpenMP)
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
8174# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8175!$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)
8176# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8177#endif
8178# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8179
8180 do l = is3%beg, is3%end
8181 do k = is2%beg, is2%end
8182 do j = is1%beg, is1%end
8183
8184 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8185 rho_l = 0._wp; rho_r = 0._wp
8186 gamma_l = 0._wp; gamma_r = 0._wp
8187 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8188 qv_l = 0._wp; qv_r = 0._wp
8189
8190
8191# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8192#if defined(MFC_OpenACC)
8193# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8194!$acc loop seq
8195# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8196#elif defined(MFC_OpenMP)
8197# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8198
8199# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8200#endif
8201 do i = 1, contxe
8202 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
8203 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
8204 end do
8205
8206
8207# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8208#if defined(MFC_OpenACC)
8209# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8210!$acc loop seq
8211# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8212#elif defined(MFC_OpenMP)
8213# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8214
8215# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8216#endif
8217 do i = 1, num_dims
8218 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
8219 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
8220 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8221 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8222 end do
8223
8224
8225# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8226#if defined(MFC_OpenACC)
8227# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8228!$acc loop seq
8229# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8230#elif defined(MFC_OpenMP)
8231# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8232
8233# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8234#endif
8235 do i = 1, num_fluids
8236 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8237 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8238 end do
8239
8240# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8241#if defined(MFC_OpenACC)
8242# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8243!$acc loop seq
8244# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8245#elif defined(MFC_OpenMP)
8246# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8247
8248# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8249#endif
8250 do i = 1, num_fluids
8251 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8252 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8253 end do
8254
8255
8256# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8257#if defined(MFC_OpenACC)
8258# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8259!$acc loop seq
8260# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8261#elif defined(MFC_OpenMP)
8262# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8263
8264# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8265#endif
8266 do i = 1, num_fluids
8267 rho_l = rho_l + alpha_rho_l(i)
8268 gamma_l = gamma_l + alpha_l(i)*gammas(i)
8269 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
8270 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
8271
8272 rho_r = rho_r + alpha_rho_r(i)
8273 gamma_r = gamma_r + alpha_r(i)*gammas(i)
8274 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
8275 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
8276 end do
8277
8278 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
8279 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
8280
8281 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
8282 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
8283
8284 h_l = (e_l + pres_l)/rho_l
8285 h_r = (e_r + pres_r)/rho_r
8286
8287
8288# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8289 if (avg_state == 1) then
8290# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8291
8292# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8293 rho_avg = sqrt(rho_l*rho_r)
8294# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8295
8296# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8297 vel_avg_rms = 0._wp
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
8302# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8303#if defined(MFC_OpenACC)
8304# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8305!$acc loop seq
8306# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8307#elif defined(MFC_OpenMP)
8308# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8309
8310# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8311#endif
8312# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8313 do i = 1, num_vels
8314# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8315 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
8316# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8317 (sqrt(rho_l) + sqrt(rho_r))**2._wp
8318# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8319 end do
8320# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8321
8322# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8323 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
8324# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8325 (sqrt(rho_l) + sqrt(rho_r))
8326# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8327
8328# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8329 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
8330# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8331 (sqrt(rho_l) + sqrt(rho_r))
8332# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8333
8334# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8335 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
8336# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8337 (sqrt(rho_l) + sqrt(rho_r))**2._wp
8338# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8339
8340# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8341 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
8342# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8343 (sqrt(rho_l) + sqrt(rho_r))
8344# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8345
8346# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8347 if (chemistry) then
8348# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8349 eps = 0.001_wp
8350# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8351 call get_species_enthalpies_rt(t_l, h_il)
8352# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8353 call get_species_enthalpies_rt(t_r, h_ir)
8354# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8355 h_il = h_il*gas_constant/molecular_weights*t_l
8356# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8357 h_ir = h_ir*gas_constant/molecular_weights*t_r
8358# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8359 call get_species_specific_heats_r(t_l, cp_il)
8360# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8361 call get_species_specific_heats_r(t_r, cp_ir)
8362# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8363
8364# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8365 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8366# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8367 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8368# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8369 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8370# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8371 if (abs(t_l - t_r) < eps) then
8372# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8373 ! Case when T_L and T_R are very close
8374# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8375 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8376# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8377 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
8378# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8379 else
8380# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8381 ! Normal calculation when T_L and T_R are sufficiently different
8382# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8383 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8384# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8385 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8386# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8387 end if
8388# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8389 gamma_avg = cp_avg/cv_avg
8390# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8391
8392# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8393 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8394# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8395 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8396# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8397
8398# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8399 end if
8400# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8401
8402# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8403 end if
8404# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8405
8406# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8407 if (avg_state == 2) then
8408# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8409 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8410# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8411 vel_avg_rms = 0._wp
8412# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8413
8414# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8415#if defined(MFC_OpenACC)
8416# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8417!$acc loop seq
8418# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8419#elif defined(MFC_OpenMP)
8420# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8421
8422# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8423#endif
8424# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8425 do i = 1, num_vels
8426# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8427 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8428# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8429 end do
8430# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8431
8432# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8433 h_avg = 5.e-1_wp*(h_l + h_r)
8434# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8435 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8436# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8437 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8438# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8439
8440# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8441 end if
8442# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8443
8444
8445 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
8446 vel_l_rms, 0._wp, c_l, qv_l)
8447
8448 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
8449 vel_r_rms, 0._wp, c_r, qv_r)
8450
8451 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8452 ! variables are placeholders to call the subroutine.
8453
8454 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
8455 vel_avg_rms, 0._wp, c_avg, qv_avg)
8456
8457 if (wave_speeds == 1) then
8458 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8459 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8460
8461 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
8462 (s_l - vel_l(dir_idx(1))) - &
8463 rho_r*vel_r(dir_idx(1))* &
8464 (s_r - vel_r(dir_idx(1)))) &
8465 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
8466 rho_r*(s_r - vel_r(dir_idx(1))))
8467 elseif (wave_speeds == 2) then
8468 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
8469 (vel_l(dir_idx(1)) - &
8470 vel_r(dir_idx(1))))
8471
8472 pres_sr = pres_sl
8473
8474 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
8475 (pres_sl/pres_l - 1._wp)*pres_l/ &
8476 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8477 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
8478 (pres_sr/pres_r - 1._wp)*pres_r/ &
8479 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8480
8481 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8482 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8483
8484 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
8485 (pres_l - pres_r)/ &
8486 (rho_avg*c_avg))
8487 end if
8488
8489 ! follows Einfeldt et al.
8490 ! s_M/P = min/max(0.,s_L/R)
8491 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8492
8493 ! goes with q_star_L/R = xi_L/R * (variable)
8494 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8495 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
8496 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
8497
8498 ! goes with numerical velocity in x/y/z directions
8499 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
8500 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8501 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8502
8503
8504# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8505#if defined(MFC_OpenACC)
8506# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8507!$acc loop seq
8508# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8509#elif defined(MFC_OpenMP)
8510# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8511
8512# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8513#endif
8514 do i = 1, contxe
8515 flux_rsx_vf(j, k, l, i) = &
8516 xi_m*alpha_rho_l(i) &
8517 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8518 + xi_p*alpha_rho_r(i) &
8519 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8520 end do
8521
8522 ! Momentum flux.
8523 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8524
8525# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8526#if defined(MFC_OpenACC)
8527# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8528!$acc loop seq
8529# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8530#elif defined(MFC_OpenMP)
8531# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8532
8533# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8534#endif
8535 do i = 1, num_dims
8536 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
8537 xi_m*(rho_l*(vel_l(dir_idx(1))* &
8538 vel_l(dir_idx(i)) + &
8539 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
8540 (1._wp - dir_flg(dir_idx(i)))* &
8541 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
8542 dir_flg(dir_idx(i))*pres_l) &
8543 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
8544 vel_r(dir_idx(i)) + &
8545 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
8546 (1._wp - dir_flg(dir_idx(i)))* &
8547 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
8548 dir_flg(dir_idx(i))*pres_r)
8549 end do
8550
8551 if (bubbles_euler) then
8552 ! Put p_tilde in
8553
8554# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8555#if defined(MFC_OpenACC)
8556# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8557!$acc loop seq
8558# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8559#elif defined(MFC_OpenMP)
8560# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8561
8562# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8563#endif
8564 do i = 1, num_dims
8565 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
8566 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) + &
8567 xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
8568 + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
8569 end do
8570 end if
8571
8572 flux_rsx_vf(j, k, l, e_idx) = 0._wp
8573
8574
8575# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8576#if defined(MFC_OpenACC)
8577# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8578!$acc loop seq
8579# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8580#elif defined(MFC_OpenMP)
8581# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8582
8583# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8584#endif
8585 do i = alf_idx, alf_idx !only advect the void fraction
8586 flux_rsx_vf(j, k, l, i) = &
8587 xi_m*ql_prim_rsx_vf(j, k, l, i) &
8588 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8589 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
8590 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8591 end do
8592
8593 ! Source for volume fraction advection equation
8594
8595# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8596#if defined(MFC_OpenACC)
8597# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8598!$acc loop seq
8599# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8600#elif defined(MFC_OpenMP)
8601# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8602
8603# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8604#endif
8605 do i = 1, num_dims
8606
8607 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
8608 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8609 end do
8610
8611 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8612
8613 ! Add advection flux for bubble variables
8614 if (bubbles_euler) then
8615
8616# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8617#if defined(MFC_OpenACC)
8618# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8619!$acc loop seq
8620# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8621#elif defined(MFC_OpenMP)
8622# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8623
8624# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8625#endif
8626 do i = bubxb, bubxe
8627 flux_rsx_vf(j, k, l, i) = &
8628 xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, i) &
8629 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8630 + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i) &
8631 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8632 end do
8633 end if
8634
8635 ! Geometrical source flux for cylindrical coordinates
8636
8637# 2716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8638# 2736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8639 end do
8640 end do
8641 end do
8642
8643# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8644
8645# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8646#if defined(MFC_OpenACC)
8647# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8648!$acc end parallel loop
8649# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8650#elif defined(MFC_OpenMP)
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
8655# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8656!$omp end target teams loop
8657# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8658#endif
8659# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8660
8661
8662 elseif (model_eqns == 2 .and. bubbles_euler) then
8663
8664# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8665
8666# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8667#if defined(MFC_OpenACC)
8668# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8669!$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)
8670# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8671#elif defined(MFC_OpenMP)
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
8678# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8679!$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)
8680# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8681#endif
8682# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8683
8684 do l = is3%beg, is3%end
8685 do k = is2%beg, is2%end
8686 do j = is1%beg, is1%end
8687
8688 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8689 rho_l = 0._wp; rho_r = 0._wp
8690 gamma_l = 0._wp; gamma_r = 0._wp
8691 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8692 qv_l = 0._wp; qv_r = 0._wp
8693
8694
8695# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8696#if defined(MFC_OpenACC)
8697# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8698!$acc loop seq
8699# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8700#elif defined(MFC_OpenMP)
8701# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8702
8703# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8704#endif
8705 do i = 1, num_fluids
8706 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8707 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8708 end do
8709
8710 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8711
8712
8713# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8714#if defined(MFC_OpenACC)
8715# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8716!$acc loop seq
8717# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8718#elif defined(MFC_OpenMP)
8719# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8720
8721# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8722#endif
8723 do i = 1, num_dims
8724 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
8725 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
8726 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8727 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8728 end do
8729
8730 ! Retain this in the refactor
8731 if (mpp_lim .and. (num_fluids > 2)) then
8732
8733# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8734#if defined(MFC_OpenACC)
8735# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8736!$acc loop seq
8737# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8738#elif defined(MFC_OpenMP)
8739# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8740
8741# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8742#endif
8743 do i = 1, num_fluids
8744 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8745 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
8746 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
8747 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8748 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8749 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
8750 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
8751 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8752 end do
8753 else if (num_fluids > 2) then
8754
8755# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8756#if defined(MFC_OpenACC)
8757# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8758!$acc loop seq
8759# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8760#elif defined(MFC_OpenMP)
8761# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8762
8763# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8764#endif
8765 do i = 1, num_fluids - 1
8766 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8767 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
8768 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
8769 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8770 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8771 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
8772 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
8773 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8774 end do
8775 else
8776 rho_l = ql_prim_rsx_vf(j, k, l, 1)
8777 gamma_l = gammas(1)
8778 pi_inf_l = pi_infs(1)
8779 qv_l = qvs(1)
8780 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
8781 gamma_r = gammas(1)
8782 pi_inf_r = pi_infs(1)
8783 qv_r = qvs(1)
8784 end if
8785
8786 if (viscous) then
8787 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
8788
8789# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8790#if defined(MFC_OpenACC)
8791# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8792!$acc loop seq
8793# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8794#elif defined(MFC_OpenMP)
8795# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8796
8797# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8798#endif
8799 do i = 1, 2
8800 re_l(i) = dflt_real
8801 re_r(i) = dflt_real
8802
8803 if (re_size(i) > 0) re_l(i) = 0._wp
8804 if (re_size(i) > 0) re_r(i) = 0._wp
8805
8806
8807# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8808#if defined(MFC_OpenACC)
8809# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8810!$acc loop seq
8811# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8812#elif defined(MFC_OpenMP)
8813# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8814
8815# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8816#endif
8817 do q = 1, re_size(i)
8818 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
8819 + re_l(i)
8820 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
8821 + re_r(i)
8822 end do
8823
8824 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8825 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8826
8827 end do
8828 end if
8829 end if
8830
8831 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
8832 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
8833
8834 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
8835 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
8836
8837 h_l = (e_l + pres_l)/rho_l
8838 h_r = (e_r + pres_r)/rho_r
8839
8840 if (avg_state == 2) then
8841
8842# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8843#if defined(MFC_OpenACC)
8844# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8845!$acc loop seq
8846# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8847#elif defined(MFC_OpenMP)
8848# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8849
8850# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8851#endif
8852 do i = 1, nb
8853 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
8854 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
8855
8856 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
8857 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
8858 if (.not. polytropic .and. .not. qbmm) then
8859 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
8860 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
8861 end if
8862 end do
8863
8864 if (.not. qbmm) then
8865 if (adv_n) then
8866 nbub_l = ql_prim_rsx_vf(j, k, l, n_idx)
8867 nbub_r = qr_prim_rsx_vf(j + 1, k, l, n_idx)
8868 else
8869 nbub_l = 0._wp
8870 nbub_r = 0._wp
8871
8872# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8873#if defined(MFC_OpenACC)
8874# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8875!$acc loop seq
8876# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8877#elif defined(MFC_OpenMP)
8878# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8879
8880# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8881#endif
8882 do i = 1, nb
8883 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
8884 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
8885 end do
8886
8887 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, e_idx + num_fluids)/nbub_l
8888 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
8889 end if
8890 else
8891 !nb stored in 0th moment of first R0 bin in variable conversion module
8892 nbub_l = ql_prim_rsx_vf(j, k, l, bubxb)
8893 nbub_r = qr_prim_rsx_vf(j + 1, k, l, bubxb)
8894 end if
8895
8896
8897# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8898#if defined(MFC_OpenACC)
8899# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8900!$acc loop seq
8901# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8902#elif defined(MFC_OpenMP)
8903# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8904
8905# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8906#endif
8907 do i = 1, nb
8908 if (.not. qbmm) then
8909 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
8910 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
8911 end if
8912 end do
8913
8914 if (qbmm) then
8915 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
8916 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
8917
8918 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
8919 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
8920
8921 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
8922 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
8923 else
8924
8925 pbwr3lbar = 0._wp
8926 pbwr3rbar = 0._wp
8927
8928 r3lbar = 0._wp
8929 r3rbar = 0._wp
8930
8931 r3v2lbar = 0._wp
8932 r3v2rbar = 0._wp
8933
8934
8935# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8936#if defined(MFC_OpenACC)
8937# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8938!$acc loop seq
8939# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8940#elif defined(MFC_OpenMP)
8941# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8942
8943# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8944#endif
8945 do i = 1, nb
8946 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
8947 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
8948
8949 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
8950 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
8951
8952 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
8953 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
8954 end do
8955 end if
8956
8957 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8958 h_avg = 5.e-1_wp*(h_l + h_r)
8959 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8960 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8961 vel_avg_rms = 0._wp
8962
8963
8964# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8965#if defined(MFC_OpenACC)
8966# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8967!$acc loop seq
8968# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8969#elif defined(MFC_OpenMP)
8970# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8971
8972# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8973#endif
8974 do i = 1, num_dims
8975 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8976 end do
8977
8978 end if
8979
8980 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
8981 vel_l_rms, 0._wp, c_l, qv_l)
8982
8983 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
8984 vel_r_rms, 0._wp, c_r, qv_r)
8985
8986 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8987 ! variables are placeholders to call the subroutine.
8988 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
8989 vel_avg_rms, 0._wp, c_avg, qv_avg)
8990
8991 if (viscous) then
8992
8993# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8994#if defined(MFC_OpenACC)
8995# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8996!$acc loop seq
8997# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8998#elif defined(MFC_OpenMP)
8999# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9000
9001# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9002#endif
9003 do i = 1, 2
9004 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9005 end do
9006 end if
9007
9008 ! Low Mach correction
9009 if (low_mach == 2) then
9010
9011# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9012 if (riemann_solver == 1 .or. riemann_solver == 5) then
9013# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9014
9015# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9016 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9017# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9018 pcorr = 0._wp
9019# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9020
9021# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9022 if (low_mach == 1) then
9023# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9024 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9025# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9026 end if
9027# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9028
9029# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9030 else if (riemann_solver == 2) then
9031# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9032 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9033# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9034 pcorr = 0._wp
9035# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9036
9037# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9038 if (low_mach == 1) then
9039# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9040 pcorr = rho_l*rho_r* &
9041# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9042 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
9043# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9044 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
9045# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9046 (zcoef - 1._wp)
9047# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9048 else if (low_mach == 2) then
9049# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9050 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))))
9051# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9052 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))))
9053# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9054 vel_l(dir_idx(1)) = vel_l_tmp
9055# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9056 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
9061# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9062
9063 end if
9064
9065 if (wave_speeds == 1) then
9066 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9067 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9068
9069 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
9070 (s_l - vel_l(dir_idx(1))) - &
9071 rho_r*vel_r(dir_idx(1))* &
9072 (s_r - vel_r(dir_idx(1)))) &
9073 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
9074 rho_r*(s_r - vel_r(dir_idx(1))))
9075 elseif (wave_speeds == 2) then
9076 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
9077 (vel_l(dir_idx(1)) - &
9078 vel_r(dir_idx(1))))
9079
9080 pres_sr = pres_sl
9081
9082 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
9083 (pres_sl/pres_l - 1._wp)*pres_l/ &
9084 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9085 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
9086 (pres_sr/pres_r - 1._wp)*pres_r/ &
9087 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9088
9089 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9090 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9091
9092 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
9093 (pres_l - pres_r)/ &
9094 (rho_avg*c_avg))
9095 end if
9096
9097 ! follows Einfeldt et al.
9098 ! s_M/P = min/max(0.,s_L/R)
9099 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9100
9101 ! goes with q_star_L/R = xi_L/R * (variable)
9102 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9103 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
9104 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
9105
9106 ! goes with numerical velocity in x/y/z directions
9107 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
9108 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9109 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9110
9111 ! Low Mach correction
9112 if (low_mach == 1) then
9113
9114# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9115 if (riemann_solver == 1 .or. riemann_solver == 5) then
9116# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9117
9118# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9119 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9120# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9121 pcorr = 0._wp
9122# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9123
9124# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9125 if (low_mach == 1) then
9126# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9127 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9128# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9129 end if
9130# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9131
9132# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9133 else if (riemann_solver == 2) then
9134# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9135 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9136# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9137 pcorr = 0._wp
9138# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9139
9140# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9141 if (low_mach == 1) then
9142# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9143 pcorr = rho_l*rho_r* &
9144# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9145 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
9146# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9147 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
9148# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9149 (zcoef - 1._wp)
9150# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9151 else if (low_mach == 2) then
9152# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9153 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))))
9154# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9155 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))))
9156# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9157 vel_l(dir_idx(1)) = vel_l_tmp
9158# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9159 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
9164# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9165
9166 else
9167 pcorr = 0._wp
9168 end if
9169
9170
9171# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9172#if defined(MFC_OpenACC)
9173# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9174!$acc loop seq
9175# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9176#elif defined(MFC_OpenMP)
9177# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9178
9179# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9180#endif
9181 do i = 1, contxe
9182 flux_rsx_vf(j, k, l, i) = &
9183 xi_m*ql_prim_rsx_vf(j, k, l, i) &
9184 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9185 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
9186 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9187 end do
9188
9189 if (bubbles_euler .and. (num_fluids > 1)) then
9190 ! Kill mass transport @ gas density
9191 flux_rsx_vf(j, k, l, contxe) = 0._wp
9192 end if
9193
9194 ! Momentum flux.
9195 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9196
9197 ! Include p_tilde
9198
9199 if (avg_state == 2) then
9200 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
9201 pres_l = pres_l - alpha_l(num_fluids)*pres_l
9202 else
9203 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - &
9204 rho_l*r3v2lbar/r3lbar)
9205 end if
9206
9207 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
9208 pres_r = pres_r - alpha_r(num_fluids)*pres_r
9209 else
9210 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - &
9211 rho_r*r3v2rbar/r3rbar)
9212 end if
9213 end if
9214
9215
9216# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9217#if defined(MFC_OpenACC)
9218# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9219!$acc loop seq
9220# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9221#elif defined(MFC_OpenMP)
9222# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9223
9224# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9225#endif
9226 do i = 1, num_dims
9227 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
9228 xi_m*(rho_l*(vel_l(dir_idx(1))* &
9229 vel_l(dir_idx(i)) + &
9230 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
9231 (1._wp - dir_flg(dir_idx(i)))* &
9232 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
9233 dir_flg(dir_idx(i))*(pres_l)) &
9234 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
9235 vel_r(dir_idx(i)) + &
9236 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
9237 (1._wp - dir_flg(dir_idx(i)))* &
9238 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
9239 dir_flg(dir_idx(i))*(pres_r)) &
9240 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9241 end do
9242
9243 ! Energy flux.
9244 ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
9245 flux_rsx_vf(j, k, l, e_idx) = &
9246 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
9247 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
9248 (rho_l*s_s + (pres_l)/ &
9249 (s_l - vel_l(dir_idx(1))))) - e_l)) &
9250 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
9251 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
9252 (rho_r*s_s + (pres_r)/ &
9253 (s_r - vel_r(dir_idx(1))))) - e_r)) &
9254 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
9255
9256 ! Volume fraction flux
9257
9258# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9259#if defined(MFC_OpenACC)
9260# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9261!$acc loop seq
9262# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9263#elif defined(MFC_OpenMP)
9264# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9265
9266# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9267#endif
9268 do i = advxb, advxe
9269 flux_rsx_vf(j, k, l, i) = &
9270 xi_m*ql_prim_rsx_vf(j, k, l, i) &
9271 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9272 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
9273 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9274 end do
9275
9276 ! Source for volume fraction advection equation
9277
9278# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9279#if defined(MFC_OpenACC)
9280# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9281!$acc loop seq
9282# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9283#elif defined(MFC_OpenMP)
9284# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9285
9286# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9287#endif
9288 do i = 1, num_dims
9289 vel_src_rsx_vf(j, k, l, dir_idx(i)) = &
9290 xi_m*(vel_l(dir_idx(i)) + &
9291 dir_flg(dir_idx(i))* &
9292 s_m*(xi_l - 1._wp)) &
9293 + xi_p*(vel_r(dir_idx(i)) + &
9294 dir_flg(dir_idx(i))* &
9295 s_p*(xi_r - 1._wp))
9296
9297 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
9298 end do
9299
9300 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9301
9302 ! Add advection flux for bubble variables
9303
9304# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9305#if defined(MFC_OpenACC)
9306# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9307!$acc loop seq
9308# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9309#elif defined(MFC_OpenMP)
9310# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9311
9312# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9313#endif
9314 do i = bubxb, bubxe
9315 flux_rsx_vf(j, k, l, i) = &
9316 xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, i) &
9317 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9318 + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i) &
9319 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9320 end do
9321
9322 if (qbmm) then
9323 flux_rsx_vf(j, k, l, bubxb) = &
9324 xi_m*nbub_l &
9325 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9326 + xi_p*nbub_r &
9327 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9328 end if
9329
9330 if (adv_n) then
9331 flux_rsx_vf(j, k, l, n_idx) = &
9332 xi_m*nbub_l &
9333 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9334 + xi_p*nbub_r &
9335 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9336 end if
9337
9338 ! Geometrical source flux for cylindrical coordinates
9339# 3150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9340# 3172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9341 end do
9342 end do
9343 end do
9344
9345# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9346
9347# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9348#if defined(MFC_OpenACC)
9349# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9350!$acc end parallel loop
9351# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9352#elif defined(MFC_OpenMP)
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
9357# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9358!$omp end target teams loop
9359# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9360#endif
9361# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9362
9363 else
9364 ! 5-EQUATION MODEL WITH HLLC
9365
9366# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9367
9368# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9369#if defined(MFC_OpenACC)
9370# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9371!$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)
9372# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9373#elif defined(MFC_OpenMP)
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
9380# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9381!$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)
9382# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9383#endif
9384# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9385
9386 do l = is3%beg, is3%end
9387 do k = is2%beg, is2%end
9388 do j = is1%beg, is1%end
9389
9390 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9391 rho_l = 0._wp; rho_r = 0._wp
9392 gamma_l = 0._wp; gamma_r = 0._wp
9393 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9394 qv_l = 0._wp; qv_r = 0._wp
9395 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9396
9397
9398# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9399#if defined(MFC_OpenACC)
9400# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9401!$acc loop seq
9402# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9403#elif defined(MFC_OpenMP)
9404# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9405
9406# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9407#endif
9408 do i = 1, num_fluids
9409 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
9410 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
9411 end do
9412
9413
9414# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9415#if defined(MFC_OpenACC)
9416# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9417!$acc loop seq
9418# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9419#elif defined(MFC_OpenMP)
9420# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9421
9422# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9423#endif
9424 do i = 1, num_dims
9425 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
9426 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
9427 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9428 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9429 end do
9430
9431 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
9432 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
9433
9434 ! Change this by splitting it into the cases
9435 ! present in the bubbles_euler
9436 if (mpp_lim) then
9437
9438# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9439#if defined(MFC_OpenACC)
9440# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9441!$acc loop seq
9442# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9443#elif defined(MFC_OpenMP)
9444# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9445
9446# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9447#endif
9448 do i = 1, num_fluids
9449 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
9450 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)
9451 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
9452 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)
9453 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, e_idx + i)
9454 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
9455 end do
9456
9457
9458# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9459#if defined(MFC_OpenACC)
9460# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9461!$acc loop seq
9462# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9463#elif defined(MFC_OpenMP)
9464# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9465
9466# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9467#endif
9468 do i = 1, num_fluids
9469 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)
9470 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)
9471 end do
9472 end if
9473
9474
9475# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9476#if defined(MFC_OpenACC)
9477# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9478!$acc loop seq
9479# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9480#elif defined(MFC_OpenMP)
9481# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9482
9483# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9484#endif
9485 do i = 1, num_fluids
9486 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
9487 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
9488 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
9489 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
9490
9491 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
9492 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
9493 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
9494 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
9495 end do
9496
9497 re_max = 0
9498 if (re_size(1) > 0) re_max = 1
9499 if (re_size(2) > 0) re_max = 2
9500
9501 if (viscous) then
9502
9503# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9504#if defined(MFC_OpenACC)
9505# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9506!$acc loop seq
9507# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9508#elif defined(MFC_OpenMP)
9509# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9510
9511# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9512#endif
9513 do i = 1, re_max
9514 re_l(i) = 0._wp
9515 re_r(i) = 0._wp
9516
9517
9518# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9519#if defined(MFC_OpenACC)
9520# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9521!$acc loop seq
9522# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9523#elif defined(MFC_OpenMP)
9524# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9525
9526# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9527#endif
9528 do q = 1, re_size(i)
9529 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
9530 + re_l(i)
9531 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
9532 + re_r(i)
9533 end do
9534
9535 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
9536 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
9537 end do
9538 end if
9539
9540 if (chemistry) then
9541 c_sum_yi_phi = 0.0_wp
9542
9543# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9544#if defined(MFC_OpenACC)
9545# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9546!$acc loop seq
9547# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9548#elif defined(MFC_OpenMP)
9549# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9550
9551# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9552#endif
9553 do i = chemxb, chemxe
9554 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
9555 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
9556 end do
9557
9558 call get_mixture_molecular_weight(ys_l, mw_l)
9559 call get_mixture_molecular_weight(ys_r, mw_r)
9560
9561# 3278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9562 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
9563 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
9564# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9565
9566 r_gas_l = gas_constant/mw_l
9567 r_gas_r = gas_constant/mw_r
9568
9569 t_l = pres_l/rho_l/r_gas_l
9570 t_r = pres_r/rho_r/r_gas_r
9571
9572 call get_species_specific_heats_r(t_l, cp_il)
9573 call get_species_specific_heats_r(t_r, cp_ir)
9574
9575 if (chem_params%gamma_method == 1) then
9576 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
9577 gamma_il = cp_il/(cp_il - 1.0_wp)
9578 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
9579
9580 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
9581 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
9582 else if (chem_params%gamma_method == 2) then
9583 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
9584 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
9585 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
9586 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
9587 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
9588
9589 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
9590 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
9591 end if
9592
9593 call get_mixture_energy_mass(t_l, ys_l, e_l)
9594 call get_mixture_energy_mass(t_r, ys_r, e_r)
9595
9596 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
9597 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
9598 h_l = (e_l + pres_l)/rho_l
9599 h_r = (e_r + pres_r)/rho_r
9600 else
9601 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
9602 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
9603
9604 h_l = (e_l + pres_l)/rho_l
9605 h_r = (e_r + pres_r)/rho_r
9606 end if
9607
9608 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
9609 if (hypoelasticity) then
9610
9611# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9612#if defined(MFC_OpenACC)
9613# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9614!$acc loop seq
9615# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9616#elif defined(MFC_OpenMP)
9617# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9618
9619# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9620#endif
9621 do i = 1, strxe - strxb + 1
9622 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
9623 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
9624 end do
9625 g_l = 0._wp
9626 g_r = 0._wp
9627
9628# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9629#if defined(MFC_OpenACC)
9630# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9631!$acc loop seq
9632# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9633#elif defined(MFC_OpenMP)
9634# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9635
9636# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9637#endif
9638 do i = 1, num_fluids
9639 g_l = g_l + alpha_l(i)*gs_rs(i)
9640 g_r = g_r + alpha_r(i)*gs_rs(i)
9641 end do
9642
9643# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9644#if defined(MFC_OpenACC)
9645# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9646!$acc loop seq
9647# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9648#elif defined(MFC_OpenMP)
9649# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9650
9651# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9652#endif
9653 do i = 1, strxe - strxb + 1
9654 ! Elastic contribution to energy if G large enough
9655 if ((g_l > verysmall) .and. (g_r > verysmall)) then
9656 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9657 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9658 ! Additional terms in 2D and 3D
9659 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
9660 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9661 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9662 end if
9663 end if
9664 end do
9665 end if
9666
9667 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
9668 if (hyperelasticity) then
9669
9670# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9671#if defined(MFC_OpenACC)
9672# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9673!$acc loop seq
9674# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9675#elif defined(MFC_OpenMP)
9676# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9677
9678# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9679#endif
9680 do i = 1, num_dims
9681 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, xibeg - 1 + i)
9682 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
9683 end do
9684 g_l = 0._wp
9685 g_r = 0._wp
9686
9687# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9688#if defined(MFC_OpenACC)
9689# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9690!$acc loop seq
9691# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9692#elif defined(MFC_OpenMP)
9693# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9694
9695# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9696#endif
9697 do i = 1, num_fluids
9698 ! Mixture left and right shear modulus
9699 g_l = g_l + alpha_l(i)*gs_rs(i)
9700 g_r = g_r + alpha_r(i)*gs_rs(i)
9701 end do
9702 ! Elastic contribution to energy if G large enough
9703 if (g_l > verysmall .and. g_r > verysmall) then
9704 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, xiend + 1)
9705 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, xiend + 1)
9706 end if
9707
9708# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9709#if defined(MFC_OpenACC)
9710# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9711!$acc loop seq
9712# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9713#elif defined(MFC_OpenMP)
9714# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9715
9716# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9717#endif
9718 do i = 1, b_size - 1
9719 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
9720 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
9721 end do
9722 end if
9723
9724 h_l = (e_l + pres_l)/rho_l
9725 h_r = (e_r + pres_r)/rho_r
9726
9727
9728# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9729 if (avg_state == 1) then
9730# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9731
9732# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9733 rho_avg = sqrt(rho_l*rho_r)
9734# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9735
9736# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9737 vel_avg_rms = 0._wp
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
9742# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9743#if defined(MFC_OpenACC)
9744# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9745!$acc loop seq
9746# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9747#elif defined(MFC_OpenMP)
9748# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9749
9750# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9751#endif
9752# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9753 do i = 1, num_vels
9754# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9755 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
9756# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9757 (sqrt(rho_l) + sqrt(rho_r))**2._wp
9758# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9759 end do
9760# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9761
9762# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9763 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
9764# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9765 (sqrt(rho_l) + sqrt(rho_r))
9766# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9767
9768# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9769 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
9770# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9771 (sqrt(rho_l) + sqrt(rho_r))
9772# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9773
9774# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9775 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
9776# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9777 (sqrt(rho_l) + sqrt(rho_r))**2._wp
9778# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9779
9780# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9781 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
9782# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9783 (sqrt(rho_l) + sqrt(rho_r))
9784# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9785
9786# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9787 if (chemistry) then
9788# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9789 eps = 0.001_wp
9790# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9791 call get_species_enthalpies_rt(t_l, h_il)
9792# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9793 call get_species_enthalpies_rt(t_r, h_ir)
9794# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9795 h_il = h_il*gas_constant/molecular_weights*t_l
9796# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9797 h_ir = h_ir*gas_constant/molecular_weights*t_r
9798# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9799 call get_species_specific_heats_r(t_l, cp_il)
9800# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9801 call get_species_specific_heats_r(t_r, cp_ir)
9802# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9803
9804# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9805 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9806# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9807 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9808# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9809 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9810# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9811 if (abs(t_l - t_r) < eps) then
9812# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9813 ! Case when T_L and T_R are very close
9814# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9815 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9816# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9817 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
9818# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9819 else
9820# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9821 ! Normal calculation when T_L and T_R are sufficiently different
9822# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9823 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9824# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9825 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9826# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9827 end if
9828# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9829 gamma_avg = cp_avg/cv_avg
9830# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9831
9832# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9833 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9834# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9835 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9836# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9837
9838# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9839 end if
9840# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9841
9842# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9843 end if
9844# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9845
9846# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9847 if (avg_state == 2) then
9848# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9849 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9850# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9851 vel_avg_rms = 0._wp
9852# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9853
9854# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9855#if defined(MFC_OpenACC)
9856# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9857!$acc loop seq
9858# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9859#elif defined(MFC_OpenMP)
9860# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9861
9862# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9863#endif
9864# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9865 do i = 1, num_vels
9866# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9867 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9868# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9869 end do
9870# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9871
9872# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9873 h_avg = 5.e-1_wp*(h_l + h_r)
9874# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9875 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9876# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9877 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9878# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9879
9880# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9881 end if
9882# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9883
9884
9885 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
9886 vel_l_rms, 0._wp, c_l, qv_l)
9887
9888 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
9889 vel_r_rms, 0._wp, c_r, qv_r)
9890
9891 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9892 ! variables are placeholders to call the subroutine.
9893 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
9894 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
9895
9896 if (viscous) then
9897 if (chemistry) then
9898 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
9899 end if
9900
9901# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9902#if defined(MFC_OpenACC)
9903# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9904!$acc loop seq
9905# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9906#elif defined(MFC_OpenMP)
9907# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9908
9909# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9910#endif
9911 do i = 1, 2
9912 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9913 end do
9914 end if
9915
9916 ! Low Mach correction
9917 if (low_mach == 2) then
9918
9919# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9920 if (riemann_solver == 1 .or. riemann_solver == 5) then
9921# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9922
9923# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9924 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9925# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9926 pcorr = 0._wp
9927# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9928
9929# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9930 if (low_mach == 1) then
9931# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9932 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9933# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9934 end if
9935# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9936
9937# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9938 else if (riemann_solver == 2) then
9939# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9940 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9941# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9942 pcorr = 0._wp
9943# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9944
9945# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9946 if (low_mach == 1) then
9947# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9948 pcorr = rho_l*rho_r* &
9949# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9950 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
9951# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9952 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
9953# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9954 (zcoef - 1._wp)
9955# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9956 else if (low_mach == 2) then
9957# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9958 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))))
9959# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9960 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))))
9961# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9962 vel_l(dir_idx(1)) = vel_l_tmp
9963# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9964 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
9969# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9970
9971 end if
9972
9973 if (wave_speeds == 1) then
9974 if (elasticity) then
9975 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
9976 (((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 + &
9977 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
9978 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
9979 (((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 + &
9980 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
9981 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
9982 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
9983 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
9984 rho_r*(s_r - vel_r(dir_idx(1))))
9985 else
9986 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9987 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9988 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
9989 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
9990 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9991
9992 end if
9993 elseif (wave_speeds == 2) then
9994 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
9995 (vel_l(dir_idx(1)) - &
9996 vel_r(dir_idx(1))))
9997
9998 pres_sr = pres_sl
9999
10000 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
10001 (pres_sl/pres_l - 1._wp)*pres_l/ &
10002 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10003 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
10004 (pres_sr/pres_r - 1._wp)*pres_r/ &
10005 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10006
10007 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10008 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10009
10010 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
10011 (pres_l - pres_r)/ &
10012 (rho_avg*c_avg))
10013 end if
10014
10015 ! follows Einfeldt et al.
10016 ! s_M/P = min/max(0.,s_L/R)
10017 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10018
10019 ! goes with q_star_L/R = xi_L/R * (variable)
10020 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10021 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
10022 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
10023
10024 ! goes with numerical velocity in x/y/z directions
10025 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
10026 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
10027 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
10028
10029 ! Low Mach correction
10030 if (low_mach == 1) then
10031
10032# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10033 if (riemann_solver == 1 .or. riemann_solver == 5) then
10034# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10035
10036# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10037 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10038# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10039 pcorr = 0._wp
10040# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10041
10042# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10043 if (low_mach == 1) then
10044# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10045 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
10046# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10047 end if
10048# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10049
10050# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10051 else if (riemann_solver == 2) then
10052# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10053 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10054# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10055 pcorr = 0._wp
10056# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10057
10058# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10059 if (low_mach == 1) then
10060# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10061 pcorr = rho_l*rho_r* &
10062# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10063 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
10064# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10065 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
10066# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10067 (zcoef - 1._wp)
10068# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10069 else if (low_mach == 2) then
10070# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10071 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))))
10072# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10073 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))))
10074# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10075 vel_l(dir_idx(1)) = vel_l_tmp
10076# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10077 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
10082# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10083
10084 else
10085 pcorr = 0._wp
10086 end if
10087
10088 ! COMPUTING THE HLLC FLUXES
10089 ! MASS FLUX.
10090
10091# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10092#if defined(MFC_OpenACC)
10093# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10094!$acc loop seq
10095# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10096#elif defined(MFC_OpenMP)
10097# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10098
10099# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10100#endif
10101 do i = 1, contxe
10102 flux_rsx_vf(j, k, l, i) = &
10103 xi_m*ql_prim_rsx_vf(j, k, l, i) &
10104 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10105 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
10106 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10107 end do
10108
10109 ! MOMENTUM FLUX.
10110 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10111
10112# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10113#if defined(MFC_OpenACC)
10114# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10115!$acc loop seq
10116# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10117#elif defined(MFC_OpenMP)
10118# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10119
10120# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10121#endif
10122 do i = 1, num_dims
10123 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
10124 xi_m*(rho_l*(vel_l(dir_idx(1))* &
10125 vel_l(dir_idx(i)) + &
10126 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
10127 (1._wp - dir_flg(dir_idx(i)))* &
10128 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
10129 dir_flg(dir_idx(i))*(pres_l)) &
10130 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
10131 vel_r(dir_idx(i)) + &
10132 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
10133 (1._wp - dir_flg(dir_idx(i)))* &
10134 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
10135 dir_flg(dir_idx(i))*(pres_r)) &
10136 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
10137 end do
10138
10139 ! ENERGY FLUX.
10140 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
10141 flux_rsx_vf(j, k, l, e_idx) = &
10142 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
10143 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
10144 (rho_l*s_s + pres_l/ &
10145 (s_l - vel_l(dir_idx(1))))) - e_l)) &
10146 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
10147 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
10148 (rho_r*s_s + pres_r/ &
10149 (s_r - vel_r(dir_idx(1))))) - e_r)) &
10150 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
10151
10152 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
10153 if (elasticity) then
10154 flux_ene_e = 0._wp
10155
10156# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10157#if defined(MFC_OpenACC)
10158# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10159!$acc loop seq
10160# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10161#elif defined(MFC_OpenMP)
10162# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10163
10164# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10165#endif
10166 do i = 1, num_dims
10167 ! MOMENTUM ELASTIC FLUX.
10168 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
10169 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) &
10170 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
10171 ! ENERGY ELASTIC FLUX.
10172 flux_ene_e = flux_ene_e - &
10173 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
10174 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
10175 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
10176 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
10177 end do
10178 flux_rsx_vf(j, k, l, e_idx) = flux_rsx_vf(j, k, l, e_idx) + flux_ene_e
10179 end if
10180
10181 ! HYPOELASTIC STRESS EVOLUTION FLUX.
10182 if (hypoelasticity) then
10183
10184# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10185#if defined(MFC_OpenACC)
10186# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10187!$acc loop seq
10188# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10189#elif defined(MFC_OpenMP)
10190# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10191
10192# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10193#endif
10194 do i = 1, strxe - strxb + 1
10195 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
10196 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)) + &
10197 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))
10198 end do
10199 end if
10200
10201 ! VOLUME FRACTION FLUX.
10202
10203# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10204#if defined(MFC_OpenACC)
10205# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10206!$acc loop seq
10207# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10208#elif defined(MFC_OpenMP)
10209# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10210
10211# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10212#endif
10213 do i = advxb, advxe
10214 flux_rsx_vf(j, k, l, i) = &
10215 xi_m*ql_prim_rsx_vf(j, k, l, i) &
10216 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10217 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
10218 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10219 end do
10220
10221 ! VOLUME FRACTION SOURCE FLUX.
10222
10223# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10224#if defined(MFC_OpenACC)
10225# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10226!$acc loop seq
10227# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10228#elif defined(MFC_OpenMP)
10229# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10230
10231# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10232#endif
10233 do i = 1, num_dims
10234 vel_src_rsx_vf(j, k, l, dir_idx(i)) = &
10235 xi_m*(vel_l(dir_idx(i)) + &
10236 dir_flg(dir_idx(i))* &
10237 s_m*(xi_l - 1._wp)) &
10238 + xi_p*(vel_r(dir_idx(i)) + &
10239 dir_flg(dir_idx(i))* &
10240 s_p*(xi_r - 1._wp))
10241 end do
10242
10243 ! COLOR FUNCTION FLUX
10244 if (surface_tension) then
10245 flux_rsx_vf(j, k, l, c_idx) = &
10246 xi_m*ql_prim_rsx_vf(j, k, l, c_idx) &
10247 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10248 + xi_p*qr_prim_rsx_vf(j + 1, k, l, c_idx) &
10249 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10250 end if
10251
10252 ! REFERENCE MAP FLUX.
10253 if (hyperelasticity) then
10254
10255# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10256#if defined(MFC_OpenACC)
10257# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10258!$acc loop seq
10259# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10260#elif defined(MFC_OpenMP)
10261# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10262
10263# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10264#endif
10265 do i = 1, num_dims
10266 flux_rsx_vf(j, k, l, xibeg - 1 + i) = &
10267 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
10268 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
10269 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
10270 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
10271 end do
10272 end if
10273
10274 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
10275
10276 if (chemistry) then
10277
10278# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10279#if defined(MFC_OpenACC)
10280# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10281!$acc loop seq
10282# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10283#elif defined(MFC_OpenMP)
10284# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10285
10286# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10287#endif
10288 do i = chemxb, chemxe
10289 y_l = ql_prim_rsx_vf(j, k, l, i)
10290 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
10291
10292 flux_rsx_vf(j, k, l, i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10293 + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10294 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
10295 end do
10296 end if
10297
10298 ! Geometrical source flux for cylindrical coordinates
10299# 3631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10300# 3653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10301
10302 end do
10303 end do
10304 end do
10305
10306# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10307
10308# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10309#if defined(MFC_OpenACC)
10310# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10311!$acc end parallel loop
10312# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10313#elif defined(MFC_OpenMP)
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
10318# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10319!$omp end target teams loop
10320# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10321#endif
10322# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10323
10324 end if
10325 end if
10326# 2084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10327
10328 if (norm_dir == 2) then
10329
10330 ! 6-EQUATION MODEL WITH HLLC
10331 if (model_eqns == 3) then
10332 !ME3
10333
10334# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10335
10336# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10337#if defined(MFC_OpenACC)
10338# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10339!$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)
10340# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10341#elif defined(MFC_OpenMP)
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
10348# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10349!$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)
10350# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10351#endif
10352# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10353
10354 do l = is3%beg, is3%end
10355 do k = is2%beg, is2%end
10356 do j = is1%beg, is1%end
10357
10358 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10359 rho_l = 0._wp; rho_r = 0._wp
10360 gamma_l = 0._wp; gamma_r = 0._wp
10361 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10362 qv_l = 0._wp; qv_r = 0._wp
10363 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
10364
10365
10366# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10367#if defined(MFC_OpenACC)
10368# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10369!$acc loop seq
10370# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10371#elif defined(MFC_OpenMP)
10372# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10373
10374# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10375#endif
10376 do i = 1, num_dims
10377 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
10378 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
10379 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10380 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10381 end do
10382
10383 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
10384 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
10385
10386 rho_l = 0._wp
10387 gamma_l = 0._wp
10388 pi_inf_l = 0._wp
10389 qv_l = 0._wp
10390
10391 rho_r = 0._wp
10392 gamma_r = 0._wp
10393 pi_inf_r = 0._wp
10394 qv_r = 0._wp
10395
10396 alpha_l_sum = 0._wp
10397 alpha_r_sum = 0._wp
10398
10399 if (mpp_lim) then
10400
10401# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10402#if defined(MFC_OpenACC)
10403# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10404!$acc loop seq
10405# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10406#elif defined(MFC_OpenMP)
10407# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10408
10409# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10410#endif
10411 do i = 1, num_fluids
10412 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
10413 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)
10414 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, e_idx + i)
10415 end do
10416
10417
10418# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10419#if defined(MFC_OpenACC)
10420# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10421!$acc loop seq
10422# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10423#elif defined(MFC_OpenMP)
10424# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10425
10426# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10427#endif
10428 do i = 1, num_fluids
10429 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
10430 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)
10431 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
10432 end do
10433
10434
10435# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10436#if defined(MFC_OpenACC)
10437# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10438!$acc loop seq
10439# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10440#elif defined(MFC_OpenMP)
10441# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10442
10443# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10444#endif
10445 do i = 1, num_fluids
10446 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)
10447 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)
10448 end do
10449 end if
10450
10451
10452# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10453#if defined(MFC_OpenACC)
10454# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10455!$acc loop seq
10456# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10457#elif defined(MFC_OpenMP)
10458# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10459
10460# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10461#endif
10462 do i = 1, num_fluids
10463 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
10464 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
10465 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
10466 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
10467
10468 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
10469 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
10470 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
10471 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
10472
10473 alpha_l(i) = ql_prim_rsy_vf(j, k, l, advxb + i - 1)
10474 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, advxb + i - 1)
10475 end do
10476
10477 if (viscous) then
10478
10479# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10480#if defined(MFC_OpenACC)
10481# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10482!$acc loop seq
10483# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10484#elif defined(MFC_OpenMP)
10485# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10486
10487# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10488#endif
10489 do i = 1, 2
10490 re_l(i) = dflt_real
10491 re_r(i) = dflt_real
10492 if (re_size(i) > 0) re_l(i) = 0._wp
10493 if (re_size(i) > 0) re_r(i) = 0._wp
10494
10495# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10496#if defined(MFC_OpenACC)
10497# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10498!$acc loop seq
10499# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10500#elif defined(MFC_OpenMP)
10501# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10502
10503# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10504#endif
10505 do q = 1, re_size(i)
10506 re_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
10507 + re_l(i)
10508 re_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
10509 + re_r(i)
10510 end do
10511 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
10512 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
10513 end do
10514 end if
10515
10516 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
10517 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
10518
10519 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
10520 if (hypoelasticity) then
10521
10522# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10523#if defined(MFC_OpenACC)
10524# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10525!$acc loop seq
10526# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10527#elif defined(MFC_OpenMP)
10528# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10529
10530# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10531#endif
10532 do i = 1, strxe - strxb + 1
10533 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
10534 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
10535 end do
10536 g_l = 0._wp; g_r = 0._wp
10537
10538# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10539#if defined(MFC_OpenACC)
10540# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10541!$acc loop seq
10542# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10543#elif defined(MFC_OpenMP)
10544# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10545
10546# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10547#endif
10548 do i = 1, num_fluids
10549 g_l = g_l + alpha_l(i)*gs_rs(i)
10550 g_r = g_r + alpha_r(i)*gs_rs(i)
10551 end do
10552
10553# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10554#if defined(MFC_OpenACC)
10555# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10556!$acc loop seq
10557# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10558#elif defined(MFC_OpenMP)
10559# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10560
10561# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10562#endif
10563 do i = 1, strxe - strxb + 1
10564 ! Elastic contribution to energy if G large enough
10565 if ((g_l > verysmall) .and. (g_r > verysmall)) then
10566 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
10567 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
10568 ! Additional terms in 2D and 3D
10569 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
10570 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
10571 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
10572 end if
10573 end if
10574 end do
10575 end if
10576
10577 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
10578 if (hyperelasticity) then
10579
10580# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10581#if defined(MFC_OpenACC)
10582# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10583!$acc loop seq
10584# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10585#elif defined(MFC_OpenMP)
10586# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10587
10588# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10589#endif
10590 do i = 1, num_dims
10591 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, xibeg - 1 + i)
10592 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
10593 end do
10594 g_l = 0._wp; g_r = 0._wp;
10595
10596# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10597#if defined(MFC_OpenACC)
10598# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10599!$acc loop seq
10600# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10601#elif defined(MFC_OpenMP)
10602# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10603
10604# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10605#endif
10606 do i = 1, num_fluids
10607 ! Mixture left and right shear modulus
10608 g_l = g_l + alpha_l(i)*gs_rs(i)
10609 g_r = g_r + alpha_r(i)*gs_rs(i)
10610 end do
10611 ! Elastic contribution to energy if G large enough
10612 if (g_l > verysmall .and. g_r > verysmall) then
10613 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, xiend + 1)
10614 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, xiend + 1)
10615 end if
10616
10617# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10618#if defined(MFC_OpenACC)
10619# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10620!$acc loop seq
10621# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10622#elif defined(MFC_OpenMP)
10623# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10624
10625# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10626#endif
10627 do i = 1, b_size - 1
10628 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
10629 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
10630 end do
10631 end if
10632
10633 h_l = (e_l + pres_l)/rho_l
10634 h_r = (e_r + pres_r)/rho_r
10635
10636
10637# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10638 if (avg_state == 1) then
10639# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10640
10641# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10642 rho_avg = sqrt(rho_l*rho_r)
10643# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10644
10645# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10646 vel_avg_rms = 0._wp
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
10651# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10652#if defined(MFC_OpenACC)
10653# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10654!$acc loop seq
10655# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10656#elif defined(MFC_OpenMP)
10657# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10658
10659# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10660#endif
10661# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10662 do i = 1, num_vels
10663# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10664 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
10665# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10666 (sqrt(rho_l) + sqrt(rho_r))**2._wp
10667# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10668 end do
10669# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10670
10671# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10672 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
10673# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10674 (sqrt(rho_l) + sqrt(rho_r))
10675# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10676
10677# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10678 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
10679# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10680 (sqrt(rho_l) + sqrt(rho_r))
10681# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10682
10683# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10684 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
10685# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10686 (sqrt(rho_l) + sqrt(rho_r))**2._wp
10687# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10688
10689# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10690 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
10691# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10692 (sqrt(rho_l) + sqrt(rho_r))
10693# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10694
10695# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10696 if (chemistry) then
10697# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10698 eps = 0.001_wp
10699# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10700 call get_species_enthalpies_rt(t_l, h_il)
10701# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10702 call get_species_enthalpies_rt(t_r, h_ir)
10703# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10704 h_il = h_il*gas_constant/molecular_weights*t_l
10705# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10706 h_ir = h_ir*gas_constant/molecular_weights*t_r
10707# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10708 call get_species_specific_heats_r(t_l, cp_il)
10709# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10710 call get_species_specific_heats_r(t_r, cp_ir)
10711# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10712
10713# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10714 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
10715# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10716 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
10717# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10718 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
10719# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10720 if (abs(t_l - t_r) < eps) then
10721# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10722 ! Case when T_L and T_R are very close
10723# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10724 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
10725# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10726 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
10727# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10728 else
10729# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10730 ! Normal calculation when T_L and T_R are sufficiently different
10731# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10732 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
10733# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10734 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
10735# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10736 end if
10737# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10738 gamma_avg = cp_avg/cv_avg
10739# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10740
10741# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10742 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
10743# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10744 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
10745# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10746
10747# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10748 end if
10749# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10750
10751# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10752 end if
10753# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10754
10755# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10756 if (avg_state == 2) then
10757# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10758 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10759# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10760 vel_avg_rms = 0._wp
10761# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10762
10763# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10764#if defined(MFC_OpenACC)
10765# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10766!$acc loop seq
10767# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10768#elif defined(MFC_OpenMP)
10769# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10770
10771# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10772#endif
10773# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10774 do i = 1, num_vels
10775# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10776 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
10777# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10778 end do
10779# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10780
10781# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10782 h_avg = 5.e-1_wp*(h_l + h_r)
10783# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10784 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
10785# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10786 qv_avg = 5.e-1_wp*(qv_l + qv_r)
10787# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10788
10789# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10790 end if
10791# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10792
10793
10794 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
10795 vel_l_rms, 0._wp, c_l, qv_l)
10796
10797 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
10798 vel_r_rms, 0._wp, c_r, qv_r)
10799
10800 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
10801 ! variables are placeholders to call the subroutine.
10802 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
10803 vel_avg_rms, 0._wp, c_avg, qv_avg)
10804
10805 if (viscous) then
10806
10807# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10808#if defined(MFC_OpenACC)
10809# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10810!$acc loop seq
10811# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10812#elif defined(MFC_OpenMP)
10813# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10814
10815# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10816#endif
10817 do i = 1, 2
10818 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
10819 end do
10820 end if
10821
10822 ! Low Mach correction
10823 if (low_mach == 2) then
10824
10825# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10826 if (riemann_solver == 1 .or. riemann_solver == 5) then
10827# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10828
10829# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10830 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10831# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10832 pcorr = 0._wp
10833# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10834
10835# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10836 if (low_mach == 1) then
10837# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10838 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
10839# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10840 end if
10841# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10842
10843# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10844 else if (riemann_solver == 2) then
10845# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10846 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10847# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10848 pcorr = 0._wp
10849# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10850
10851# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10852 if (low_mach == 1) then
10853# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10854 pcorr = rho_l*rho_r* &
10855# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10856 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
10857# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10858 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
10859# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10860 (zcoef - 1._wp)
10861# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10862 else if (low_mach == 2) then
10863# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10864 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))))
10865# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10866 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))))
10867# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10868 vel_l(dir_idx(1)) = vel_l_tmp
10869# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10870 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
10875# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10876
10877 end if
10878
10879 ! COMPUTING THE DIRECT WAVE SPEEDS
10880 if (wave_speeds == 1) then
10881 if (elasticity) then
10882 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
10883 (((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 + &
10884 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
10885 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
10886 (((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 + &
10887 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
10888 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
10889 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
10890 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
10891 rho_r*(s_r - vel_r(dir_idx(1))))
10892 else
10893 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
10894 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
10895 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
10896 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
10897 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
10898
10899 end if
10900 elseif (wave_speeds == 2) then
10901 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
10902 (vel_l(dir_idx(1)) - &
10903 vel_r(dir_idx(1))))
10904
10905 pres_sr = pres_sl
10906
10907 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
10908 (pres_sl/pres_l - 1._wp)*pres_l/ &
10909 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10910 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
10911 (pres_sr/pres_r - 1._wp)*pres_r/ &
10912 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10913
10914 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10915 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10916
10917 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
10918 (pres_l - pres_r)/ &
10919 (rho_avg*c_avg))
10920 end if
10921
10922 ! follows Einfeldt et al.
10923 ! s_M/P = min/max(0.,s_L/R)
10924 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10925
10926 ! goes with q_star_L/R = xi_L/R * (variable)
10927 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10928 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
10929 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
10930
10931 ! goes with numerical star velocity in x/y/z directions
10932 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
10933 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
10934 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
10935
10936 ! goes with the numerical velocity in x/y/z directions
10937 ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
10938 xi_mp = -min(0._wp, sign(1._wp, s_l))
10939 xi_pp = max(0._wp, sign(1._wp, s_r))
10940
10941 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
10942 (rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) + &
10943 xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
10944 (rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
10945 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) + &
10946 xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
10947
10948 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + &
10949 xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
10950
10951 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + &
10952 xi_mp*xi_pp*(s_s - vel_r(dir_idx(1)))
10953
10954 ! Low Mach correction
10955 if (low_mach == 1) then
10956
10957# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10958 if (riemann_solver == 1 .or. riemann_solver == 5) then
10959# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10960
10961# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10962 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10963# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10964 pcorr = 0._wp
10965# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10966
10967# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10968 if (low_mach == 1) then
10969# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10970 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
10971# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10972 end if
10973# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10974
10975# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10976 else if (riemann_solver == 2) then
10977# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10978 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10979# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10980 pcorr = 0._wp
10981# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10982
10983# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10984 if (low_mach == 1) then
10985# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10986 pcorr = rho_l*rho_r* &
10987# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10988 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
10989# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10990 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
10991# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10992 (zcoef - 1._wp)
10993# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10994 else if (low_mach == 2) then
10995# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10996 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))))
10997# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10998 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))))
10999# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11000 vel_l(dir_idx(1)) = vel_l_tmp
11001# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11002 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
11007# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11008
11009 else
11010 pcorr = 0._wp
11011 end if
11012
11013 ! COMPUTING FLUXES
11014 ! MASS FLUX.
11015
11016# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11017#if defined(MFC_OpenACC)
11018# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11019!$acc loop seq
11020# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11021#elif defined(MFC_OpenMP)
11022# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11023
11024# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11025#endif
11026 do i = 1, contxe
11027 flux_rsy_vf(j, k, l, i) = &
11028 xi_m*ql_prim_rsy_vf(j, k, l, i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + &
11029 xi_p*qr_prim_rsy_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11030 end do
11031
11032 ! MOMENTUM FLUX.
11033 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11034
11035# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11036#if defined(MFC_OpenACC)
11037# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11038!$acc loop seq
11039# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11040#elif defined(MFC_OpenMP)
11041# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11042
11043# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11044#endif
11045 do i = 1, num_dims
11046 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = rho_star*vel_k_star* &
11047 (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 &
11048 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
11049 end do
11050
11051 ! ENERGY FLUX.
11052 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
11053 flux_rsy_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star &
11054 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
11055
11056 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
11057 if (elasticity) then
11058 flux_ene_e = 0._wp;
11059
11060# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11061#if defined(MFC_OpenACC)
11062# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11063!$acc loop seq
11064# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11065#elif defined(MFC_OpenMP)
11066# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11067
11068# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11069#endif
11070 do i = 1, num_dims
11071 ! MOMENTUM ELASTIC FLUX.
11072 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
11073 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) &
11074 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
11075 ! ENERGY ELASTIC FLUX.
11076 flux_ene_e = flux_ene_e - &
11077 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
11078 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
11079 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
11080 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
11081 end do
11082 flux_rsy_vf(j, k, l, e_idx) = flux_rsy_vf(j, k, l, e_idx) + flux_ene_e
11083 end if
11084
11085 ! VOLUME FRACTION FLUX.
11086
11087# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11088#if defined(MFC_OpenACC)
11089# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11090!$acc loop seq
11091# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11092#elif defined(MFC_OpenMP)
11093# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11094
11095# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11096#endif
11097 do i = advxb, advxe
11098 flux_rsy_vf(j, k, l, i) = &
11099 xi_m*ql_prim_rsy_vf(j, k, l, i)*s_s + &
11100 xi_p*qr_prim_rsy_vf(j + 1, k, l, i)*s_s
11101 end do
11102
11103 ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX.
11104
11105# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11106#if defined(MFC_OpenACC)
11107# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11108!$acc loop seq
11109# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11110#elif defined(MFC_OpenMP)
11111# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11112
11113# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11114#endif
11115 do i = 1, num_dims
11116 vel_src_rsy_vf(j, k, l, dir_idx(i)) = &
11117 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)))) + &
11118 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))))
11119 end do
11120
11121 ! INTERNAL ENERGIES ADVECTION FLUX.
11122 ! K-th pressure and velocity in preparation for the internal energy flux
11123
11124# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11125#if defined(MFC_OpenACC)
11126# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11127!$acc loop seq
11128# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11129#elif defined(MFC_OpenMP)
11130# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11131
11132# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11133#endif
11134 do i = 1, num_fluids
11135 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))* &
11136 xi_l**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) + &
11137 xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i)))* &
11138 xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) + pres_r)
11139
11140 flux_rsy_vf(j, k, l, i + intxb - 1) = &
11141 ((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))* &
11142 (gammas(i)*p_k_star + pi_infs(i)) + &
11143 (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))* &
11144 qvs(i))*vel_k_star &
11145 + (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))
11146 end do
11147
11148 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
11149
11150 ! HYPOELASTIC STRESS EVOLUTION FLUX.
11151 if (hypoelasticity) then
11152
11153# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11154#if defined(MFC_OpenACC)
11155# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11156!$acc loop seq
11157# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11158#elif defined(MFC_OpenMP)
11159# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11160
11161# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11162#endif
11163 do i = 1, strxe - strxb + 1
11164 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
11165 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)) + &
11166 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))
11167 end do
11168 end if
11169
11170 ! REFERENCE MAP FLUX.
11171 if (hyperelasticity) then
11172
11173# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11174#if defined(MFC_OpenACC)
11175# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11176!$acc loop seq
11177# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11178#elif defined(MFC_OpenMP)
11179# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11180
11181# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11182#endif
11183 do i = 1, num_dims
11184 flux_rsy_vf(j, k, l, xibeg - 1 + i) = &
11185 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
11186 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
11187 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
11188 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
11189 end do
11190 end if
11191
11192 ! COLOR FUNCTION FLUX
11193 if (surface_tension) then
11194 flux_rsy_vf(j, k, l, c_idx) = &
11195 (xi_m*ql_prim_rsy_vf(j, k, l, c_idx) + &
11196 xi_p*qr_prim_rsy_vf(j + 1, k, l, c_idx))*s_s
11197 end if
11198
11199 ! Geometrical source flux for cylindrical coordinates
11200# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11201 if (cyl_coord) then
11202 !Substituting the advective flux into the inviscid geometrical source flux
11203
11204# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11205#if defined(MFC_OpenACC)
11206# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11207!$acc loop seq
11208# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11209#elif defined(MFC_OpenMP)
11210# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11211
11212# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11213#endif
11214 do i = 1, e_idx
11215 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11216 end do
11217
11218# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11219#if defined(MFC_OpenACC)
11220# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11221!$acc loop seq
11222# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11223#elif defined(MFC_OpenMP)
11224# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11225
11226# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11227#endif
11228 do i = intxb, intxe
11229 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11230 end do
11231 ! Recalculating the radial momentum geometric source flux
11232 flux_gsrc_rsy_vf(j, k, l, momxb - 1 + dir_idx(1)) = &
11233 flux_gsrc_rsy_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_star
11234 ! Geometrical source of the void fraction(s) is zero
11235
11236# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11237#if defined(MFC_OpenACC)
11238# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11239!$acc loop seq
11240# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11241#elif defined(MFC_OpenMP)
11242# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11243
11244# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11245#endif
11246 do i = advxb, advxe
11247 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
11248 end do
11249 end if
11250# 2478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11251# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11252
11253 end do
11254 end do
11255 end do
11256
11257# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11258
11259# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11260#if defined(MFC_OpenACC)
11261# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11262!$acc end parallel loop
11263# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11264#elif defined(MFC_OpenMP)
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
11269# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11270!$omp end target teams loop
11271# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11272#endif
11273# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11274
11275
11276 elseif (model_eqns == 4) then
11277 !ME4
11278
11279# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11280
11281# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11282#if defined(MFC_OpenACC)
11283# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11284!$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)
11285# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11286#elif defined(MFC_OpenMP)
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
11293# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11294!$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)
11295# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11296#endif
11297# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11298
11299 do l = is3%beg, is3%end
11300 do k = is2%beg, is2%end
11301 do j = is1%beg, is1%end
11302
11303 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11304 rho_l = 0._wp; rho_r = 0._wp
11305 gamma_l = 0._wp; gamma_r = 0._wp
11306 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11307 qv_l = 0._wp; qv_r = 0._wp
11308
11309
11310# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11311#if defined(MFC_OpenACC)
11312# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11313!$acc loop seq
11314# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11315#elif defined(MFC_OpenMP)
11316# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11317
11318# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11319#endif
11320 do i = 1, contxe
11321 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
11322 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
11323 end do
11324
11325
11326# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11327#if defined(MFC_OpenACC)
11328# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11329!$acc loop seq
11330# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11331#elif defined(MFC_OpenMP)
11332# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11333
11334# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11335#endif
11336 do i = 1, num_dims
11337 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
11338 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
11339 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11340 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11341 end do
11342
11343
11344# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11345#if defined(MFC_OpenACC)
11346# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11347!$acc loop seq
11348# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11349#elif defined(MFC_OpenMP)
11350# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11351
11352# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11353#endif
11354 do i = 1, num_fluids
11355 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11356 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11357 end do
11358
11359# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11360#if defined(MFC_OpenACC)
11361# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11362!$acc loop seq
11363# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11364#elif defined(MFC_OpenMP)
11365# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11366
11367# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11368#endif
11369 do i = 1, num_fluids
11370 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11371 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11372 end do
11373
11374
11375# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11376#if defined(MFC_OpenACC)
11377# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11378!$acc loop seq
11379# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11380#elif defined(MFC_OpenMP)
11381# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11382
11383# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11384#endif
11385 do i = 1, num_fluids
11386 rho_l = rho_l + alpha_rho_l(i)
11387 gamma_l = gamma_l + alpha_l(i)*gammas(i)
11388 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
11389 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
11390
11391 rho_r = rho_r + alpha_rho_r(i)
11392 gamma_r = gamma_r + alpha_r(i)*gammas(i)
11393 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
11394 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
11395 end do
11396
11397 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
11398 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
11399
11400 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
11401 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
11402
11403 h_l = (e_l + pres_l)/rho_l
11404 h_r = (e_r + pres_r)/rho_r
11405
11406
11407# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11408 if (avg_state == 1) then
11409# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11410
11411# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11412 rho_avg = sqrt(rho_l*rho_r)
11413# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11414
11415# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11416 vel_avg_rms = 0._wp
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
11421# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11422#if defined(MFC_OpenACC)
11423# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11424!$acc loop seq
11425# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11426#elif defined(MFC_OpenMP)
11427# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11428
11429# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11430#endif
11431# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11432 do i = 1, num_vels
11433# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11434 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
11435# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11436 (sqrt(rho_l) + sqrt(rho_r))**2._wp
11437# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11438 end do
11439# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11440
11441# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11442 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
11443# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11444 (sqrt(rho_l) + sqrt(rho_r))
11445# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11446
11447# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11448 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
11449# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11450 (sqrt(rho_l) + sqrt(rho_r))
11451# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11452
11453# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11454 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
11455# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11456 (sqrt(rho_l) + sqrt(rho_r))**2._wp
11457# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11458
11459# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11460 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
11461# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11462 (sqrt(rho_l) + sqrt(rho_r))
11463# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11464
11465# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11466 if (chemistry) then
11467# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11468 eps = 0.001_wp
11469# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11470 call get_species_enthalpies_rt(t_l, h_il)
11471# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11472 call get_species_enthalpies_rt(t_r, h_ir)
11473# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11474 h_il = h_il*gas_constant/molecular_weights*t_l
11475# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11476 h_ir = h_ir*gas_constant/molecular_weights*t_r
11477# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11478 call get_species_specific_heats_r(t_l, cp_il)
11479# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11480 call get_species_specific_heats_r(t_r, cp_ir)
11481# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11482
11483# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11484 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
11485# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11486 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
11487# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11488 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
11489# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11490 if (abs(t_l - t_r) < eps) then
11491# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11492 ! Case when T_L and T_R are very close
11493# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11494 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
11495# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11496 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
11497# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11498 else
11499# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11500 ! Normal calculation when T_L and T_R are sufficiently different
11501# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11502 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
11503# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11504 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
11505# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11506 end if
11507# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11508 gamma_avg = cp_avg/cv_avg
11509# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11510
11511# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11512 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
11513# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11514 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
11515# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11516
11517# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11518 end if
11519# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11520
11521# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11522 end if
11523# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11524
11525# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11526 if (avg_state == 2) then
11527# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11528 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11529# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11530 vel_avg_rms = 0._wp
11531# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11532
11533# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11534#if defined(MFC_OpenACC)
11535# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11536!$acc loop seq
11537# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11538#elif defined(MFC_OpenMP)
11539# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11540
11541# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11542#endif
11543# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11544 do i = 1, num_vels
11545# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11546 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11547# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11548 end do
11549# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11550
11551# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11552 h_avg = 5.e-1_wp*(h_l + h_r)
11553# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11554 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11555# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11556 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11557# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11558
11559# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11560 end if
11561# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11562
11563
11564 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
11565 vel_l_rms, 0._wp, c_l, qv_l)
11566
11567 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
11568 vel_r_rms, 0._wp, c_r, qv_r)
11569
11570 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11571 ! variables are placeholders to call the subroutine.
11572
11573 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
11574 vel_avg_rms, 0._wp, c_avg, qv_avg)
11575
11576 if (wave_speeds == 1) then
11577 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11578 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11579
11580 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
11581 (s_l - vel_l(dir_idx(1))) - &
11582 rho_r*vel_r(dir_idx(1))* &
11583 (s_r - vel_r(dir_idx(1)))) &
11584 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
11585 rho_r*(s_r - vel_r(dir_idx(1))))
11586 elseif (wave_speeds == 2) then
11587 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
11588 (vel_l(dir_idx(1)) - &
11589 vel_r(dir_idx(1))))
11590
11591 pres_sr = pres_sl
11592
11593 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
11594 (pres_sl/pres_l - 1._wp)*pres_l/ &
11595 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11596 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
11597 (pres_sr/pres_r - 1._wp)*pres_r/ &
11598 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11599
11600 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11601 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11602
11603 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
11604 (pres_l - pres_r)/ &
11605 (rho_avg*c_avg))
11606 end if
11607
11608 ! follows Einfeldt et al.
11609 ! s_M/P = min/max(0.,s_L/R)
11610 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11611
11612 ! goes with q_star_L/R = xi_L/R * (variable)
11613 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11614 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
11615 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
11616
11617 ! goes with numerical velocity in x/y/z directions
11618 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
11619 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
11620 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
11621
11622
11623# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11624#if defined(MFC_OpenACC)
11625# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11626!$acc loop seq
11627# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11628#elif defined(MFC_OpenMP)
11629# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11630
11631# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11632#endif
11633 do i = 1, contxe
11634 flux_rsy_vf(j, k, l, i) = &
11635 xi_m*alpha_rho_l(i) &
11636 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11637 + xi_p*alpha_rho_r(i) &
11638 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11639 end do
11640
11641 ! Momentum flux.
11642 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11643
11644# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11645#if defined(MFC_OpenACC)
11646# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11647!$acc loop seq
11648# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11649#elif defined(MFC_OpenMP)
11650# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11651
11652# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11653#endif
11654 do i = 1, num_dims
11655 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
11656 xi_m*(rho_l*(vel_l(dir_idx(1))* &
11657 vel_l(dir_idx(i)) + &
11658 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
11659 (1._wp - dir_flg(dir_idx(i)))* &
11660 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
11661 dir_flg(dir_idx(i))*pres_l) &
11662 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
11663 vel_r(dir_idx(i)) + &
11664 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
11665 (1._wp - dir_flg(dir_idx(i)))* &
11666 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
11667 dir_flg(dir_idx(i))*pres_r)
11668 end do
11669
11670 if (bubbles_euler) then
11671 ! Put p_tilde in
11672
11673# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11674#if defined(MFC_OpenACC)
11675# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11676!$acc loop seq
11677# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11678#elif defined(MFC_OpenMP)
11679# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11680
11681# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11682#endif
11683 do i = 1, num_dims
11684 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
11685 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) + &
11686 xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
11687 + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
11688 end do
11689 end if
11690
11691 flux_rsy_vf(j, k, l, e_idx) = 0._wp
11692
11693
11694# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11695#if defined(MFC_OpenACC)
11696# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11697!$acc loop seq
11698# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11699#elif defined(MFC_OpenMP)
11700# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11701
11702# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11703#endif
11704 do i = alf_idx, alf_idx !only advect the void fraction
11705 flux_rsy_vf(j, k, l, i) = &
11706 xi_m*ql_prim_rsy_vf(j, k, l, i) &
11707 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11708 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
11709 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11710 end do
11711
11712 ! Source for volume fraction advection equation
11713
11714# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11715#if defined(MFC_OpenACC)
11716# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11717!$acc loop seq
11718# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11719#elif defined(MFC_OpenMP)
11720# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11721
11722# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11723#endif
11724 do i = 1, num_dims
11725
11726 vel_src_rsy_vf(j, k, l, dir_idx(i)) = 0._wp
11727 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
11728 end do
11729
11730 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
11731
11732 ! Add advection flux for bubble variables
11733 if (bubbles_euler) then
11734
11735# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11736#if defined(MFC_OpenACC)
11737# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11738!$acc loop seq
11739# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11740#elif defined(MFC_OpenMP)
11741# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11742
11743# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11744#endif
11745 do i = bubxb, bubxe
11746 flux_rsy_vf(j, k, l, i) = &
11747 xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, i) &
11748 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11749 + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, i) &
11750 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11751 end do
11752 end if
11753
11754 ! Geometrical source flux for cylindrical coordinates
11755
11756# 2691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11757 if (cyl_coord) then
11758 ! Substituting the advective flux into the inviscid geometrical source flux
11759
11760# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11761#if defined(MFC_OpenACC)
11762# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11763!$acc loop seq
11764# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11765#elif defined(MFC_OpenMP)
11766# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11767
11768# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11769#endif
11770 do i = 1, e_idx
11771 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11772 end do
11773 ! Recalculating the radial momentum geometric source flux
11774 flux_gsrc_rsy_vf(j, k, l, contxe + dir_idx(1)) = &
11775 xi_m*(rho_l*(vel_l(dir_idx(1))* &
11776 vel_l(dir_idx(1)) + &
11777 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
11778 (1._wp - dir_flg(dir_idx(1)))* &
11779 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
11780 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
11781 vel_r(dir_idx(1)) + &
11782 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
11783 (1._wp - dir_flg(dir_idx(1)))* &
11784 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
11785 ! Geometrical source of the void fraction(s) is zero
11786
11787# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11788#if defined(MFC_OpenACC)
11789# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11790!$acc loop seq
11791# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11792#elif defined(MFC_OpenMP)
11793# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11794
11795# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11796#endif
11797 do i = advxb, advxe
11798 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
11799 end do
11800 end if
11801# 2716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11802# 2736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11803 end do
11804 end do
11805 end do
11806
11807# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11808
11809# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11810#if defined(MFC_OpenACC)
11811# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11812!$acc end parallel loop
11813# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11814#elif defined(MFC_OpenMP)
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
11819# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11820!$omp end target teams loop
11821# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11822#endif
11823# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11824
11825
11826 elseif (model_eqns == 2 .and. bubbles_euler) then
11827
11828# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11829
11830# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11831#if defined(MFC_OpenACC)
11832# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11833!$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)
11834# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11835#elif defined(MFC_OpenMP)
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
11842# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11843!$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)
11844# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11845#endif
11846# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11847
11848 do l = is3%beg, is3%end
11849 do k = is2%beg, is2%end
11850 do j = is1%beg, is1%end
11851
11852 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11853 rho_l = 0._wp; rho_r = 0._wp
11854 gamma_l = 0._wp; gamma_r = 0._wp
11855 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11856 qv_l = 0._wp; qv_r = 0._wp
11857
11858
11859# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11860#if defined(MFC_OpenACC)
11861# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11862!$acc loop seq
11863# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11864#elif defined(MFC_OpenMP)
11865# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11866
11867# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11868#endif
11869 do i = 1, num_fluids
11870 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11871 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11872 end do
11873
11874 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11875
11876
11877# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11878#if defined(MFC_OpenACC)
11879# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11880!$acc loop seq
11881# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11882#elif defined(MFC_OpenMP)
11883# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11884
11885# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11886#endif
11887 do i = 1, num_dims
11888 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
11889 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
11890 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11891 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11892 end do
11893
11894 ! Retain this in the refactor
11895 if (mpp_lim .and. (num_fluids > 2)) then
11896
11897# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11898#if defined(MFC_OpenACC)
11899# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11900!$acc loop seq
11901# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11902#elif defined(MFC_OpenMP)
11903# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11904
11905# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11906#endif
11907 do i = 1, num_fluids
11908 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
11909 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
11910 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
11911 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
11912 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
11913 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
11914 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
11915 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
11916 end do
11917 else if (num_fluids > 2) then
11918
11919# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11920#if defined(MFC_OpenACC)
11921# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11922!$acc loop seq
11923# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11924#elif defined(MFC_OpenMP)
11925# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11926
11927# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11928#endif
11929 do i = 1, num_fluids - 1
11930 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
11931 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
11932 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
11933 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
11934 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
11935 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
11936 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
11937 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
11938 end do
11939 else
11940 rho_l = ql_prim_rsy_vf(j, k, l, 1)
11941 gamma_l = gammas(1)
11942 pi_inf_l = pi_infs(1)
11943 qv_l = qvs(1)
11944 rho_r = qr_prim_rsy_vf(j + 1, k, l, 1)
11945 gamma_r = gammas(1)
11946 pi_inf_r = pi_infs(1)
11947 qv_r = qvs(1)
11948 end if
11949
11950 if (viscous) then
11951 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
11952
11953# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11954#if defined(MFC_OpenACC)
11955# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11956!$acc loop seq
11957# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11958#elif defined(MFC_OpenMP)
11959# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11960
11961# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11962#endif
11963 do i = 1, 2
11964 re_l(i) = dflt_real
11965 re_r(i) = dflt_real
11966
11967 if (re_size(i) > 0) re_l(i) = 0._wp
11968 if (re_size(i) > 0) re_r(i) = 0._wp
11969
11970
11971# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11972#if defined(MFC_OpenACC)
11973# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11974!$acc loop seq
11975# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11976#elif defined(MFC_OpenMP)
11977# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11978
11979# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11980#endif
11981 do q = 1, re_size(i)
11982 re_l(i) = (1._wp - ql_prim_rsy_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
11983 + re_l(i)
11984 re_r(i) = (1._wp - qr_prim_rsy_vf(j + 1, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
11985 + re_r(i)
11986 end do
11987
11988 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
11989 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
11990
11991 end do
11992 end if
11993 end if
11994
11995 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
11996 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
11997
11998 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
11999 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
12000
12001 h_l = (e_l + pres_l)/rho_l
12002 h_r = (e_r + pres_r)/rho_r
12003
12004 if (avg_state == 2) then
12005
12006# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12007#if defined(MFC_OpenACC)
12008# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12009!$acc loop seq
12010# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12011#elif defined(MFC_OpenMP)
12012# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12013
12014# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12015#endif
12016 do i = 1, nb
12017 r0_l(i) = ql_prim_rsy_vf(j, k, l, rs(i))
12018 r0_r(i) = qr_prim_rsy_vf(j + 1, k, l, rs(i))
12019
12020 v0_l(i) = ql_prim_rsy_vf(j, k, l, vs(i))
12021 v0_r(i) = qr_prim_rsy_vf(j + 1, k, l, vs(i))
12022 if (.not. polytropic .and. .not. qbmm) then
12023 p0_l(i) = ql_prim_rsy_vf(j, k, l, ps(i))
12024 p0_r(i) = qr_prim_rsy_vf(j + 1, k, l, ps(i))
12025 end if
12026 end do
12027
12028 if (.not. qbmm) then
12029 if (adv_n) then
12030 nbub_l = ql_prim_rsy_vf(j, k, l, n_idx)
12031 nbub_r = qr_prim_rsy_vf(j + 1, k, l, n_idx)
12032 else
12033 nbub_l = 0._wp
12034 nbub_r = 0._wp
12035
12036# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12037#if defined(MFC_OpenACC)
12038# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12039!$acc loop seq
12040# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12041#elif defined(MFC_OpenMP)
12042# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12043
12044# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12045#endif
12046 do i = 1, nb
12047 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
12048 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
12049 end do
12050
12051 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsy_vf(j, k, l, e_idx + num_fluids)/nbub_l
12052 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsy_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
12053 end if
12054 else
12055 !nb stored in 0th moment of first R0 bin in variable conversion module
12056 nbub_l = ql_prim_rsy_vf(j, k, l, bubxb)
12057 nbub_r = qr_prim_rsy_vf(j + 1, k, l, bubxb)
12058 end if
12059
12060
12061# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12062#if defined(MFC_OpenACC)
12063# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12064!$acc loop seq
12065# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12066#elif defined(MFC_OpenMP)
12067# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12068
12069# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12070#endif
12071 do i = 1, nb
12072 if (.not. qbmm) then
12073 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
12074 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
12075 end if
12076 end do
12077
12078 if (qbmm) then
12079 pbwr3lbar = mom_sp_rsy_vf(j, k, l, 4)
12080 pbwr3rbar = mom_sp_rsy_vf(j + 1, k, l, 4)
12081
12082 r3lbar = mom_sp_rsy_vf(j, k, l, 1)
12083 r3rbar = mom_sp_rsy_vf(j + 1, k, l, 1)
12084
12085 r3v2lbar = mom_sp_rsy_vf(j, k, l, 3)
12086 r3v2rbar = mom_sp_rsy_vf(j + 1, k, l, 3)
12087 else
12088
12089 pbwr3lbar = 0._wp
12090 pbwr3rbar = 0._wp
12091
12092 r3lbar = 0._wp
12093 r3rbar = 0._wp
12094
12095 r3v2lbar = 0._wp
12096 r3v2rbar = 0._wp
12097
12098
12099# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12100#if defined(MFC_OpenACC)
12101# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12102!$acc loop seq
12103# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12104#elif defined(MFC_OpenMP)
12105# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12106
12107# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12108#endif
12109 do i = 1, nb
12110 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
12111 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
12112
12113 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
12114 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
12115
12116 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
12117 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
12118 end do
12119 end if
12120
12121 rho_avg = 5.e-1_wp*(rho_l + rho_r)
12122 h_avg = 5.e-1_wp*(h_l + h_r)
12123 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
12124 qv_avg = 5.e-1_wp*(qv_l + qv_r)
12125 vel_avg_rms = 0._wp
12126
12127
12128# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12129#if defined(MFC_OpenACC)
12130# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12131!$acc loop seq
12132# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12133#elif defined(MFC_OpenMP)
12134# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12135
12136# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12137#endif
12138 do i = 1, num_dims
12139 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
12140 end do
12141
12142 end if
12143
12144 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
12145 vel_l_rms, 0._wp, c_l, qv_l)
12146
12147 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
12148 vel_r_rms, 0._wp, c_r, qv_r)
12149
12150 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
12151 ! variables are placeholders to call the subroutine.
12152 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
12153 vel_avg_rms, 0._wp, c_avg, qv_avg)
12154
12155 if (viscous) then
12156
12157# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12158#if defined(MFC_OpenACC)
12159# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12160!$acc loop seq
12161# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12162#elif defined(MFC_OpenMP)
12163# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12164
12165# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12166#endif
12167 do i = 1, 2
12168 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
12169 end do
12170 end if
12171
12172 ! Low Mach correction
12173 if (low_mach == 2) then
12174
12175# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12176 if (riemann_solver == 1 .or. riemann_solver == 5) then
12177# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12178
12179# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12180 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12181# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12182 pcorr = 0._wp
12183# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12184
12185# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12186 if (low_mach == 1) then
12187# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12188 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12189# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12190 end if
12191# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12192
12193# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12194 else if (riemann_solver == 2) then
12195# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12196 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12197# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12198 pcorr = 0._wp
12199# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12200
12201# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12202 if (low_mach == 1) then
12203# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12204 pcorr = rho_l*rho_r* &
12205# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12206 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
12207# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12208 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
12209# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12210 (zcoef - 1._wp)
12211# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12212 else if (low_mach == 2) then
12213# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12214 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))))
12215# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12216 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))))
12217# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12218 vel_l(dir_idx(1)) = vel_l_tmp
12219# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12220 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
12225# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12226
12227 end if
12228
12229 if (wave_speeds == 1) then
12230 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12231 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12232
12233 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
12234 (s_l - vel_l(dir_idx(1))) - &
12235 rho_r*vel_r(dir_idx(1))* &
12236 (s_r - vel_r(dir_idx(1)))) &
12237 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
12238 rho_r*(s_r - vel_r(dir_idx(1))))
12239 elseif (wave_speeds == 2) then
12240 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
12241 (vel_l(dir_idx(1)) - &
12242 vel_r(dir_idx(1))))
12243
12244 pres_sr = pres_sl
12245
12246 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
12247 (pres_sl/pres_l - 1._wp)*pres_l/ &
12248 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12249 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
12250 (pres_sr/pres_r - 1._wp)*pres_r/ &
12251 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12252
12253 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12254 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12255
12256 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
12257 (pres_l - pres_r)/ &
12258 (rho_avg*c_avg))
12259 end if
12260
12261 ! follows Einfeldt et al.
12262 ! s_M/P = min/max(0.,s_L/R)
12263 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12264
12265 ! goes with q_star_L/R = xi_L/R * (variable)
12266 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12267 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
12268 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
12269
12270 ! goes with numerical velocity in x/y/z directions
12271 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
12272 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
12273 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
12274
12275 ! Low Mach correction
12276 if (low_mach == 1) then
12277
12278# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12279 if (riemann_solver == 1 .or. riemann_solver == 5) then
12280# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12281
12282# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12283 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12284# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12285 pcorr = 0._wp
12286# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12287
12288# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12289 if (low_mach == 1) then
12290# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12291 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12292# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12293 end if
12294# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12295
12296# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12297 else if (riemann_solver == 2) then
12298# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12299 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12300# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12301 pcorr = 0._wp
12302# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12303
12304# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12305 if (low_mach == 1) then
12306# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12307 pcorr = rho_l*rho_r* &
12308# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12309 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
12310# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12311 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
12312# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12313 (zcoef - 1._wp)
12314# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12315 else if (low_mach == 2) then
12316# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12317 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))))
12318# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12319 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))))
12320# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12321 vel_l(dir_idx(1)) = vel_l_tmp
12322# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12323 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
12328# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12329
12330 else
12331 pcorr = 0._wp
12332 end if
12333
12334
12335# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12336#if defined(MFC_OpenACC)
12337# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12338!$acc loop seq
12339# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12340#elif defined(MFC_OpenMP)
12341# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12342
12343# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12344#endif
12345 do i = 1, contxe
12346 flux_rsy_vf(j, k, l, i) = &
12347 xi_m*ql_prim_rsy_vf(j, k, l, i) &
12348 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12349 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
12350 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12351 end do
12352
12353 if (bubbles_euler .and. (num_fluids > 1)) then
12354 ! Kill mass transport @ gas density
12355 flux_rsy_vf(j, k, l, contxe) = 0._wp
12356 end if
12357
12358 ! Momentum flux.
12359 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12360
12361 ! Include p_tilde
12362
12363 if (avg_state == 2) then
12364 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
12365 pres_l = pres_l - alpha_l(num_fluids)*pres_l
12366 else
12367 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - &
12368 rho_l*r3v2lbar/r3lbar)
12369 end if
12370
12371 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
12372 pres_r = pres_r - alpha_r(num_fluids)*pres_r
12373 else
12374 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - &
12375 rho_r*r3v2rbar/r3rbar)
12376 end if
12377 end if
12378
12379
12380# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12381#if defined(MFC_OpenACC)
12382# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12383!$acc loop seq
12384# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12385#elif defined(MFC_OpenMP)
12386# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12387
12388# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12389#endif
12390 do i = 1, num_dims
12391 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
12392 xi_m*(rho_l*(vel_l(dir_idx(1))* &
12393 vel_l(dir_idx(i)) + &
12394 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
12395 (1._wp - dir_flg(dir_idx(i)))* &
12396 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
12397 dir_flg(dir_idx(i))*(pres_l)) &
12398 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
12399 vel_r(dir_idx(i)) + &
12400 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
12401 (1._wp - dir_flg(dir_idx(i)))* &
12402 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
12403 dir_flg(dir_idx(i))*(pres_r)) &
12404 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
12405 end do
12406
12407 ! Energy flux.
12408 ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
12409 flux_rsy_vf(j, k, l, e_idx) = &
12410 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
12411 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
12412 (rho_l*s_s + (pres_l)/ &
12413 (s_l - vel_l(dir_idx(1))))) - e_l)) &
12414 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
12415 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
12416 (rho_r*s_s + (pres_r)/ &
12417 (s_r - vel_r(dir_idx(1))))) - e_r)) &
12418 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
12419
12420 ! Volume fraction flux
12421
12422# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12423#if defined(MFC_OpenACC)
12424# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12425!$acc loop seq
12426# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12427#elif defined(MFC_OpenMP)
12428# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12429
12430# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12431#endif
12432 do i = advxb, advxe
12433 flux_rsy_vf(j, k, l, i) = &
12434 xi_m*ql_prim_rsy_vf(j, k, l, i) &
12435 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12436 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
12437 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12438 end do
12439
12440 ! Source for volume fraction advection equation
12441
12442# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12443#if defined(MFC_OpenACC)
12444# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12445!$acc loop seq
12446# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12447#elif defined(MFC_OpenMP)
12448# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12449
12450# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12451#endif
12452 do i = 1, num_dims
12453 vel_src_rsy_vf(j, k, l, dir_idx(i)) = &
12454 xi_m*(vel_l(dir_idx(i)) + &
12455 dir_flg(dir_idx(i))* &
12456 s_m*(xi_l - 1._wp)) &
12457 + xi_p*(vel_r(dir_idx(i)) + &
12458 dir_flg(dir_idx(i))* &
12459 s_p*(xi_r - 1._wp))
12460
12461 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
12462 end do
12463
12464 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
12465
12466 ! Add advection flux for bubble variables
12467
12468# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12469#if defined(MFC_OpenACC)
12470# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12471!$acc loop seq
12472# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12473#elif defined(MFC_OpenMP)
12474# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12475
12476# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12477#endif
12478 do i = bubxb, bubxe
12479 flux_rsy_vf(j, k, l, i) = &
12480 xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, i) &
12481 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12482 + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, i) &
12483 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12484 end do
12485
12486 if (qbmm) then
12487 flux_rsy_vf(j, k, l, bubxb) = &
12488 xi_m*nbub_l &
12489 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12490 + xi_p*nbub_r &
12491 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12492 end if
12493
12494 if (adv_n) then
12495 flux_rsy_vf(j, k, l, n_idx) = &
12496 xi_m*nbub_l &
12497 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12498 + xi_p*nbub_r &
12499 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12500 end if
12501
12502 ! Geometrical source flux for cylindrical coordinates
12503# 3125 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12504 if (cyl_coord) then
12505 ! Substituting the advective flux into the inviscid geometrical source flux
12506
12507# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12508#if defined(MFC_OpenACC)
12509# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12510!$acc loop seq
12511# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12512#elif defined(MFC_OpenMP)
12513# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12514
12515# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12516#endif
12517 do i = 1, e_idx
12518 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
12519 end do
12520 ! Recalculating the radial momentum geometric source flux
12521 flux_gsrc_rsy_vf(j, k, l, contxe + dir_idx(1)) = &
12522 xi_m*(rho_l*(vel_l(dir_idx(1))* &
12523 vel_l(dir_idx(1)) + &
12524 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
12525 (1._wp - dir_flg(dir_idx(1)))* &
12526 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
12527 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
12528 vel_r(dir_idx(1)) + &
12529 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
12530 (1._wp - dir_flg(dir_idx(1)))* &
12531 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
12532 ! Geometrical source of the void fraction(s) is zero
12533
12534# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12535#if defined(MFC_OpenACC)
12536# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12537!$acc loop seq
12538# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12539#elif defined(MFC_OpenMP)
12540# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12541
12542# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12543#endif
12544 do i = advxb, advxe
12545 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
12546 end do
12547 end if
12548# 3150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12549# 3172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12550 end do
12551 end do
12552 end do
12553
12554# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12555
12556# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12557#if defined(MFC_OpenACC)
12558# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12559!$acc end parallel loop
12560# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12561#elif defined(MFC_OpenMP)
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
12566# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12567!$omp end target teams loop
12568# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12569#endif
12570# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12571
12572 else
12573 ! 5-EQUATION MODEL WITH HLLC
12574
12575# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12576
12577# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12578#if defined(MFC_OpenACC)
12579# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12580!$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)
12581# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12582#elif defined(MFC_OpenMP)
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
12589# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12590!$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)
12591# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12592#endif
12593# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12594
12595 do l = is3%beg, is3%end
12596 do k = is2%beg, is2%end
12597 do j = is1%beg, is1%end
12598
12599 vel_l_rms = 0._wp; vel_r_rms = 0._wp
12600 rho_l = 0._wp; rho_r = 0._wp
12601 gamma_l = 0._wp; gamma_r = 0._wp
12602 pi_inf_l = 0._wp; pi_inf_r = 0._wp
12603 qv_l = 0._wp; qv_r = 0._wp
12604 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
12605
12606
12607# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12608#if defined(MFC_OpenACC)
12609# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12610!$acc loop seq
12611# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12612#elif defined(MFC_OpenMP)
12613# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12614
12615# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12616#endif
12617 do i = 1, num_fluids
12618 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
12619 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
12620 end do
12621
12622
12623# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12624#if defined(MFC_OpenACC)
12625# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12626!$acc loop seq
12627# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12628#elif defined(MFC_OpenMP)
12629# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12630
12631# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12632#endif
12633 do i = 1, num_dims
12634 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
12635 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
12636 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
12637 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
12638 end do
12639
12640 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
12641 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
12642
12643 ! Change this by splitting it into the cases
12644 ! present in the bubbles_euler
12645 if (mpp_lim) then
12646
12647# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12648#if defined(MFC_OpenACC)
12649# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12650!$acc loop seq
12651# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12652#elif defined(MFC_OpenMP)
12653# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12654
12655# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12656#endif
12657 do i = 1, num_fluids
12658 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
12659 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)
12660 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
12661 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)
12662 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, e_idx + i)
12663 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
12664 end do
12665
12666
12667# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12668#if defined(MFC_OpenACC)
12669# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12670!$acc loop seq
12671# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12672#elif defined(MFC_OpenMP)
12673# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12674
12675# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12676#endif
12677 do i = 1, num_fluids
12678 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)
12679 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)
12680 end do
12681 end if
12682
12683
12684# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12685#if defined(MFC_OpenACC)
12686# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12687!$acc loop seq
12688# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12689#elif defined(MFC_OpenMP)
12690# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12691
12692# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12693#endif
12694 do i = 1, num_fluids
12695 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
12696 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
12697 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
12698 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
12699
12700 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
12701 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
12702 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
12703 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
12704 end do
12705
12706 re_max = 0
12707 if (re_size(1) > 0) re_max = 1
12708 if (re_size(2) > 0) re_max = 2
12709
12710 if (viscous) then
12711
12712# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12713#if defined(MFC_OpenACC)
12714# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12715!$acc loop seq
12716# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12717#elif defined(MFC_OpenMP)
12718# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12719
12720# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12721#endif
12722 do i = 1, re_max
12723 re_l(i) = 0._wp
12724 re_r(i) = 0._wp
12725
12726
12727# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12728#if defined(MFC_OpenACC)
12729# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12730!$acc loop seq
12731# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12732#elif defined(MFC_OpenMP)
12733# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12734
12735# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12736#endif
12737 do q = 1, re_size(i)
12738 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
12739 + re_l(i)
12740 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
12741 + re_r(i)
12742 end do
12743
12744 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
12745 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
12746 end do
12747 end if
12748
12749 if (chemistry) then
12750 c_sum_yi_phi = 0.0_wp
12751
12752# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12753#if defined(MFC_OpenACC)
12754# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12755!$acc loop seq
12756# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12757#elif defined(MFC_OpenMP)
12758# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12759
12760# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12761#endif
12762 do i = chemxb, chemxe
12763 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
12764 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
12765 end do
12766
12767 call get_mixture_molecular_weight(ys_l, mw_l)
12768 call get_mixture_molecular_weight(ys_r, mw_r)
12769
12770# 3278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12771 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
12772 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
12773# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12774
12775 r_gas_l = gas_constant/mw_l
12776 r_gas_r = gas_constant/mw_r
12777
12778 t_l = pres_l/rho_l/r_gas_l
12779 t_r = pres_r/rho_r/r_gas_r
12780
12781 call get_species_specific_heats_r(t_l, cp_il)
12782 call get_species_specific_heats_r(t_r, cp_ir)
12783
12784 if (chem_params%gamma_method == 1) then
12785 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
12786 gamma_il = cp_il/(cp_il - 1.0_wp)
12787 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
12788
12789 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
12790 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
12791 else if (chem_params%gamma_method == 2) then
12792 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
12793 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
12794 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
12795 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
12796 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
12797
12798 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
12799 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
12800 end if
12801
12802 call get_mixture_energy_mass(t_l, ys_l, e_l)
12803 call get_mixture_energy_mass(t_r, ys_r, e_r)
12804
12805 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
12806 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
12807 h_l = (e_l + pres_l)/rho_l
12808 h_r = (e_r + pres_r)/rho_r
12809 else
12810 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
12811 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
12812
12813 h_l = (e_l + pres_l)/rho_l
12814 h_r = (e_r + pres_r)/rho_r
12815 end if
12816
12817 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
12818 if (hypoelasticity) then
12819
12820# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12821#if defined(MFC_OpenACC)
12822# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12823!$acc loop seq
12824# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12825#elif defined(MFC_OpenMP)
12826# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12827
12828# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12829#endif
12830 do i = 1, strxe - strxb + 1
12831 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
12832 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
12833 end do
12834 g_l = 0._wp
12835 g_r = 0._wp
12836
12837# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12838#if defined(MFC_OpenACC)
12839# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12840!$acc loop seq
12841# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12842#elif defined(MFC_OpenMP)
12843# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12844
12845# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12846#endif
12847 do i = 1, num_fluids
12848 g_l = g_l + alpha_l(i)*gs_rs(i)
12849 g_r = g_r + alpha_r(i)*gs_rs(i)
12850 end do
12851
12852# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12853#if defined(MFC_OpenACC)
12854# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12855!$acc loop seq
12856# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12857#elif defined(MFC_OpenMP)
12858# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12859
12860# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12861#endif
12862 do i = 1, strxe - strxb + 1
12863 ! Elastic contribution to energy if G large enough
12864 if ((g_l > verysmall) .and. (g_r > verysmall)) then
12865 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12866 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12867 ! Additional terms in 2D and 3D
12868 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
12869 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12870 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12871 end if
12872 end if
12873 end do
12874 end if
12875
12876 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
12877 if (hyperelasticity) then
12878
12879# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12880#if defined(MFC_OpenACC)
12881# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12882!$acc loop seq
12883# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12884#elif defined(MFC_OpenMP)
12885# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12886
12887# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12888#endif
12889 do i = 1, num_dims
12890 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, xibeg - 1 + i)
12891 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
12892 end do
12893 g_l = 0._wp
12894 g_r = 0._wp
12895
12896# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12897#if defined(MFC_OpenACC)
12898# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12899!$acc loop seq
12900# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12901#elif defined(MFC_OpenMP)
12902# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12903
12904# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12905#endif
12906 do i = 1, num_fluids
12907 ! Mixture left and right shear modulus
12908 g_l = g_l + alpha_l(i)*gs_rs(i)
12909 g_r = g_r + alpha_r(i)*gs_rs(i)
12910 end do
12911 ! Elastic contribution to energy if G large enough
12912 if (g_l > verysmall .and. g_r > verysmall) then
12913 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, xiend + 1)
12914 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, xiend + 1)
12915 end if
12916
12917# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12918#if defined(MFC_OpenACC)
12919# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12920!$acc loop seq
12921# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12922#elif defined(MFC_OpenMP)
12923# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12924
12925# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12926#endif
12927 do i = 1, b_size - 1
12928 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
12929 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
12930 end do
12931 end if
12932
12933 h_l = (e_l + pres_l)/rho_l
12934 h_r = (e_r + pres_r)/rho_r
12935
12936
12937# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12938 if (avg_state == 1) then
12939# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12940
12941# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12942 rho_avg = sqrt(rho_l*rho_r)
12943# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12944
12945# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12946 vel_avg_rms = 0._wp
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
12951# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12952#if defined(MFC_OpenACC)
12953# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12954!$acc loop seq
12955# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12956#elif defined(MFC_OpenMP)
12957# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12958
12959# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12960#endif
12961# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12962 do i = 1, num_vels
12963# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12964 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
12965# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12966 (sqrt(rho_l) + sqrt(rho_r))**2._wp
12967# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12968 end do
12969# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12970
12971# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12972 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
12973# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12974 (sqrt(rho_l) + sqrt(rho_r))
12975# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12976
12977# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12978 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
12979# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12980 (sqrt(rho_l) + sqrt(rho_r))
12981# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12982
12983# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12984 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
12985# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12986 (sqrt(rho_l) + sqrt(rho_r))**2._wp
12987# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12988
12989# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12990 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
12991# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12992 (sqrt(rho_l) + sqrt(rho_r))
12993# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12994
12995# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12996 if (chemistry) then
12997# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12998 eps = 0.001_wp
12999# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13000 call get_species_enthalpies_rt(t_l, h_il)
13001# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13002 call get_species_enthalpies_rt(t_r, h_ir)
13003# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13004 h_il = h_il*gas_constant/molecular_weights*t_l
13005# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13006 h_ir = h_ir*gas_constant/molecular_weights*t_r
13007# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13008 call get_species_specific_heats_r(t_l, cp_il)
13009# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13010 call get_species_specific_heats_r(t_r, cp_ir)
13011# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13012
13013# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13014 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13015# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13016 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13017# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13018 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13019# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13020 if (abs(t_l - t_r) < eps) then
13021# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13022 ! Case when T_L and T_R are very close
13023# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13024 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13025# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13026 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
13027# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13028 else
13029# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13030 ! Normal calculation when T_L and T_R are sufficiently different
13031# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13032 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13033# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13034 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13035# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13036 end if
13037# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13038 gamma_avg = cp_avg/cv_avg
13039# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13040
13041# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13042 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13043# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13044 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13045# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13046
13047# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13048 end if
13049# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13050
13051# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13052 end if
13053# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13054
13055# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13056 if (avg_state == 2) then
13057# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13058 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13059# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13060 vel_avg_rms = 0._wp
13061# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13062
13063# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13064#if defined(MFC_OpenACC)
13065# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13066!$acc loop seq
13067# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13068#elif defined(MFC_OpenMP)
13069# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13070
13071# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13072#endif
13073# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13074 do i = 1, num_vels
13075# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13076 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13077# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13078 end do
13079# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13080
13081# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13082 h_avg = 5.e-1_wp*(h_l + h_r)
13083# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13084 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13085# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13086 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13087# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13088
13089# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13090 end if
13091# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13092
13093
13094 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
13095 vel_l_rms, 0._wp, c_l, qv_l)
13096
13097 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
13098 vel_r_rms, 0._wp, c_r, qv_r)
13099
13100 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13101 ! variables are placeholders to call the subroutine.
13102 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
13103 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
13104
13105 if (viscous) then
13106 if (chemistry) then
13107 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
13108 end if
13109
13110# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13111#if defined(MFC_OpenACC)
13112# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13113!$acc loop seq
13114# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13115#elif defined(MFC_OpenMP)
13116# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13117
13118# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13119#endif
13120 do i = 1, 2
13121 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
13122 end do
13123 end if
13124
13125 ! Low Mach correction
13126 if (low_mach == 2) then
13127
13128# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13129 if (riemann_solver == 1 .or. riemann_solver == 5) then
13130# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13131
13132# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13133 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13134# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13135 pcorr = 0._wp
13136# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13137
13138# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13139 if (low_mach == 1) then
13140# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13141 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
13142# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13143 end if
13144# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13145
13146# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13147 else if (riemann_solver == 2) then
13148# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13149 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13150# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13151 pcorr = 0._wp
13152# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13153
13154# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13155 if (low_mach == 1) then
13156# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13157 pcorr = rho_l*rho_r* &
13158# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13159 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
13160# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13161 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
13162# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13163 (zcoef - 1._wp)
13164# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13165 else if (low_mach == 2) then
13166# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13167 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))))
13168# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13169 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))))
13170# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13171 vel_l(dir_idx(1)) = vel_l_tmp
13172# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13173 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
13178# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13179
13180 end if
13181
13182 if (wave_speeds == 1) then
13183 if (elasticity) then
13184 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
13185 (((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 + &
13186 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
13187 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
13188 (((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 + &
13189 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
13190 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
13191 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
13192 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
13193 rho_r*(s_r - vel_r(dir_idx(1))))
13194 else
13195 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
13196 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
13197 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
13198 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
13199 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
13200
13201 end if
13202 elseif (wave_speeds == 2) then
13203 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
13204 (vel_l(dir_idx(1)) - &
13205 vel_r(dir_idx(1))))
13206
13207 pres_sr = pres_sl
13208
13209 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
13210 (pres_sl/pres_l - 1._wp)*pres_l/ &
13211 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
13212 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
13213 (pres_sr/pres_r - 1._wp)*pres_r/ &
13214 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
13215
13216 s_l = vel_l(dir_idx(1)) - c_l*ms_l
13217 s_r = vel_r(dir_idx(1)) + c_r*ms_r
13218
13219 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
13220 (pres_l - pres_r)/ &
13221 (rho_avg*c_avg))
13222 end if
13223
13224 ! follows Einfeldt et al.
13225 ! s_M/P = min/max(0.,s_L/R)
13226 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
13227
13228 ! goes with q_star_L/R = xi_L/R * (variable)
13229 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
13230 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
13231 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
13232
13233 ! goes with numerical velocity in x/y/z directions
13234 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
13235 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
13236 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
13237
13238 ! Low Mach correction
13239 if (low_mach == 1) then
13240
13241# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13242 if (riemann_solver == 1 .or. riemann_solver == 5) then
13243# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13244
13245# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13246 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13247# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13248 pcorr = 0._wp
13249# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13250
13251# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13252 if (low_mach == 1) then
13253# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13254 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
13255# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13256 end if
13257# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13258
13259# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13260 else if (riemann_solver == 2) then
13261# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13262 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13263# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13264 pcorr = 0._wp
13265# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13266
13267# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13268 if (low_mach == 1) then
13269# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13270 pcorr = rho_l*rho_r* &
13271# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13272 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
13273# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13274 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
13275# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13276 (zcoef - 1._wp)
13277# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13278 else if (low_mach == 2) then
13279# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13280 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))))
13281# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13282 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))))
13283# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13284 vel_l(dir_idx(1)) = vel_l_tmp
13285# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13286 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
13291# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13292
13293 else
13294 pcorr = 0._wp
13295 end if
13296
13297 ! COMPUTING THE HLLC FLUXES
13298 ! MASS FLUX.
13299
13300# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13301#if defined(MFC_OpenACC)
13302# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13303!$acc loop seq
13304# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13305#elif defined(MFC_OpenMP)
13306# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13307
13308# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13309#endif
13310 do i = 1, contxe
13311 flux_rsy_vf(j, k, l, i) = &
13312 xi_m*ql_prim_rsy_vf(j, k, l, i) &
13313 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13314 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
13315 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13316 end do
13317
13318 ! MOMENTUM FLUX.
13319 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13320
13321# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13322#if defined(MFC_OpenACC)
13323# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13324!$acc loop seq
13325# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13326#elif defined(MFC_OpenMP)
13327# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13328
13329# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13330#endif
13331 do i = 1, num_dims
13332 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
13333 xi_m*(rho_l*(vel_l(dir_idx(1))* &
13334 vel_l(dir_idx(i)) + &
13335 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
13336 (1._wp - dir_flg(dir_idx(i)))* &
13337 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
13338 dir_flg(dir_idx(i))*(pres_l)) &
13339 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
13340 vel_r(dir_idx(i)) + &
13341 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
13342 (1._wp - dir_flg(dir_idx(i)))* &
13343 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
13344 dir_flg(dir_idx(i))*(pres_r)) &
13345 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
13346 end do
13347
13348 ! ENERGY FLUX.
13349 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
13350 flux_rsy_vf(j, k, l, e_idx) = &
13351 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
13352 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
13353 (rho_l*s_s + pres_l/ &
13354 (s_l - vel_l(dir_idx(1))))) - e_l)) &
13355 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
13356 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
13357 (rho_r*s_s + pres_r/ &
13358 (s_r - vel_r(dir_idx(1))))) - e_r)) &
13359 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
13360
13361 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
13362 if (elasticity) then
13363 flux_ene_e = 0._wp
13364
13365# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13366#if defined(MFC_OpenACC)
13367# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13368!$acc loop seq
13369# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13370#elif defined(MFC_OpenMP)
13371# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13372
13373# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13374#endif
13375 do i = 1, num_dims
13376 ! MOMENTUM ELASTIC FLUX.
13377 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
13378 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) &
13379 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
13380 ! ENERGY ELASTIC FLUX.
13381 flux_ene_e = flux_ene_e - &
13382 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
13383 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
13384 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
13385 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
13386 end do
13387 flux_rsy_vf(j, k, l, e_idx) = flux_rsy_vf(j, k, l, e_idx) + flux_ene_e
13388 end if
13389
13390 ! HYPOELASTIC STRESS EVOLUTION FLUX.
13391 if (hypoelasticity) then
13392
13393# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13394#if defined(MFC_OpenACC)
13395# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13396!$acc loop seq
13397# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13398#elif defined(MFC_OpenMP)
13399# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13400
13401# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13402#endif
13403 do i = 1, strxe - strxb + 1
13404 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
13405 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)) + &
13406 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))
13407 end do
13408 end if
13409
13410 ! VOLUME FRACTION FLUX.
13411
13412# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13413#if defined(MFC_OpenACC)
13414# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13415!$acc loop seq
13416# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13417#elif defined(MFC_OpenMP)
13418# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13419
13420# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13421#endif
13422 do i = advxb, advxe
13423 flux_rsy_vf(j, k, l, i) = &
13424 xi_m*ql_prim_rsy_vf(j, k, l, i) &
13425 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13426 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
13427 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13428 end do
13429
13430 ! VOLUME FRACTION SOURCE FLUX.
13431
13432# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13433#if defined(MFC_OpenACC)
13434# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13435!$acc loop seq
13436# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13437#elif defined(MFC_OpenMP)
13438# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13439
13440# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13441#endif
13442 do i = 1, num_dims
13443 vel_src_rsy_vf(j, k, l, dir_idx(i)) = &
13444 xi_m*(vel_l(dir_idx(i)) + &
13445 dir_flg(dir_idx(i))* &
13446 s_m*(xi_l - 1._wp)) &
13447 + xi_p*(vel_r(dir_idx(i)) + &
13448 dir_flg(dir_idx(i))* &
13449 s_p*(xi_r - 1._wp))
13450 end do
13451
13452 ! COLOR FUNCTION FLUX
13453 if (surface_tension) then
13454 flux_rsy_vf(j, k, l, c_idx) = &
13455 xi_m*ql_prim_rsy_vf(j, k, l, c_idx) &
13456 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13457 + xi_p*qr_prim_rsy_vf(j + 1, k, l, c_idx) &
13458 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13459 end if
13460
13461 ! REFERENCE MAP FLUX.
13462 if (hyperelasticity) then
13463
13464# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13465#if defined(MFC_OpenACC)
13466# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13467!$acc loop seq
13468# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13469#elif defined(MFC_OpenMP)
13470# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13471
13472# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13473#endif
13474 do i = 1, num_dims
13475 flux_rsy_vf(j, k, l, xibeg - 1 + i) = &
13476 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
13477 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
13478 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
13479 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
13480 end do
13481 end if
13482
13483 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
13484
13485 if (chemistry) then
13486
13487# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13488#if defined(MFC_OpenACC)
13489# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13490!$acc loop seq
13491# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13492#elif defined(MFC_OpenMP)
13493# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13494
13495# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13496#endif
13497 do i = chemxb, chemxe
13498 y_l = ql_prim_rsy_vf(j, k, l, i)
13499 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
13500
13501 flux_rsy_vf(j, k, l, i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13502 + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13503 flux_src_rsy_vf(j, k, l, i) = 0.0_wp
13504 end do
13505 end if
13506
13507 ! Geometrical source flux for cylindrical coordinates
13508# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13509 if (cyl_coord) then
13510 !Substituting the advective flux into the inviscid geometrical source flux
13511
13512# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13513#if defined(MFC_OpenACC)
13514# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13515!$acc loop seq
13516# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13517#elif defined(MFC_OpenMP)
13518# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13519
13520# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13521#endif
13522 do i = 1, e_idx
13523 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
13524 end do
13525 ! Recalculating the radial momentum geometric source flux
13526 flux_gsrc_rsy_vf(j, k, l, contxe + dir_idx(1)) = &
13527 xi_m*(rho_l*(vel_l(dir_idx(1))* &
13528 vel_l(dir_idx(1)) + &
13529 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
13530 (1._wp - dir_flg(dir_idx(1)))* &
13531 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
13532 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
13533 vel_r(dir_idx(1)) + &
13534 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
13535 (1._wp - dir_flg(dir_idx(1)))* &
13536 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
13537 ! Geometrical source of the void fraction(s) is zero
13538
13539# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13540#if defined(MFC_OpenACC)
13541# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13542!$acc loop seq
13543# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13544#elif defined(MFC_OpenMP)
13545# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13546
13547# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13548#endif
13549 do i = advxb, advxe
13550 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
13551 end do
13552 end if
13553# 3631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13554# 3653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13555
13556 end do
13557 end do
13558 end do
13559
13560# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13561
13562# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13563#if defined(MFC_OpenACC)
13564# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13565!$acc end parallel loop
13566# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13567#elif defined(MFC_OpenMP)
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
13572# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13573!$omp end target teams loop
13574# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13575#endif
13576# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13577
13578 end if
13579 end if
13580# 2084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13581
13582 if (norm_dir == 3) then
13583
13584 ! 6-EQUATION MODEL WITH HLLC
13585 if (model_eqns == 3) then
13586 !ME3
13587
13588# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13589
13590# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13591#if defined(MFC_OpenACC)
13592# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13593!$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)
13594# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13595#elif defined(MFC_OpenMP)
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
13602# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13603!$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)
13604# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13605#endif
13606# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13607
13608 do l = is3%beg, is3%end
13609 do k = is2%beg, is2%end
13610 do j = is1%beg, is1%end
13611
13612 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13613 rho_l = 0._wp; rho_r = 0._wp
13614 gamma_l = 0._wp; gamma_r = 0._wp
13615 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13616 qv_l = 0._wp; qv_r = 0._wp
13617 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
13618
13619
13620# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13621#if defined(MFC_OpenACC)
13622# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13623!$acc loop seq
13624# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13625#elif defined(MFC_OpenMP)
13626# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13627
13628# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13629#endif
13630 do i = 1, num_dims
13631 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
13632 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
13633 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13634 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13635 end do
13636
13637 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
13638 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
13639
13640 rho_l = 0._wp
13641 gamma_l = 0._wp
13642 pi_inf_l = 0._wp
13643 qv_l = 0._wp
13644
13645 rho_r = 0._wp
13646 gamma_r = 0._wp
13647 pi_inf_r = 0._wp
13648 qv_r = 0._wp
13649
13650 alpha_l_sum = 0._wp
13651 alpha_r_sum = 0._wp
13652
13653 if (mpp_lim) then
13654
13655# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13656#if defined(MFC_OpenACC)
13657# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13658!$acc loop seq
13659# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13660#elif defined(MFC_OpenMP)
13661# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13662
13663# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13664#endif
13665 do i = 1, num_fluids
13666 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
13667 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)
13668 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, e_idx + i)
13669 end do
13670
13671
13672# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13673#if defined(MFC_OpenACC)
13674# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13675!$acc loop seq
13676# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13677#elif defined(MFC_OpenMP)
13678# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13679
13680# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13681#endif
13682 do i = 1, num_fluids
13683 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
13684 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)
13685 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
13686 end do
13687
13688
13689# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13690#if defined(MFC_OpenACC)
13691# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13692!$acc loop seq
13693# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13694#elif defined(MFC_OpenMP)
13695# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13696
13697# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13698#endif
13699 do i = 1, num_fluids
13700 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)
13701 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)
13702 end do
13703 end if
13704
13705
13706# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13707#if defined(MFC_OpenACC)
13708# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13709!$acc loop seq
13710# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13711#elif defined(MFC_OpenMP)
13712# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13713
13714# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13715#endif
13716 do i = 1, num_fluids
13717 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
13718 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
13719 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
13720 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
13721
13722 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
13723 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
13724 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
13725 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
13726
13727 alpha_l(i) = ql_prim_rsz_vf(j, k, l, advxb + i - 1)
13728 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, advxb + i - 1)
13729 end do
13730
13731 if (viscous) then
13732
13733# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13734#if defined(MFC_OpenACC)
13735# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13736!$acc loop seq
13737# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13738#elif defined(MFC_OpenMP)
13739# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13740
13741# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13742#endif
13743 do i = 1, 2
13744 re_l(i) = dflt_real
13745 re_r(i) = dflt_real
13746 if (re_size(i) > 0) re_l(i) = 0._wp
13747 if (re_size(i) > 0) re_r(i) = 0._wp
13748
13749# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13750#if defined(MFC_OpenACC)
13751# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13752!$acc loop seq
13753# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13754#elif defined(MFC_OpenMP)
13755# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13756
13757# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13758#endif
13759 do q = 1, re_size(i)
13760 re_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
13761 + re_l(i)
13762 re_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
13763 + re_r(i)
13764 end do
13765 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
13766 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
13767 end do
13768 end if
13769
13770 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
13771 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
13772
13773 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
13774 if (hypoelasticity) then
13775
13776# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13777#if defined(MFC_OpenACC)
13778# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13779!$acc loop seq
13780# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13781#elif defined(MFC_OpenMP)
13782# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13783
13784# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13785#endif
13786 do i = 1, strxe - strxb + 1
13787 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
13788 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
13789 end do
13790 g_l = 0._wp; g_r = 0._wp
13791
13792# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13793#if defined(MFC_OpenACC)
13794# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13795!$acc loop seq
13796# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13797#elif defined(MFC_OpenMP)
13798# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13799
13800# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13801#endif
13802 do i = 1, num_fluids
13803 g_l = g_l + alpha_l(i)*gs_rs(i)
13804 g_r = g_r + alpha_r(i)*gs_rs(i)
13805 end do
13806
13807# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13808#if defined(MFC_OpenACC)
13809# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13810!$acc loop seq
13811# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13812#elif defined(MFC_OpenMP)
13813# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13814
13815# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13816#endif
13817 do i = 1, strxe - strxb + 1
13818 ! Elastic contribution to energy if G large enough
13819 if ((g_l > verysmall) .and. (g_r > verysmall)) then
13820 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
13821 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
13822 ! Additional terms in 2D and 3D
13823 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
13824 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
13825 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
13826 end if
13827 end if
13828 end do
13829 end if
13830
13831 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
13832 if (hyperelasticity) then
13833
13834# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13835#if defined(MFC_OpenACC)
13836# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13837!$acc loop seq
13838# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13839#elif defined(MFC_OpenMP)
13840# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13841
13842# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13843#endif
13844 do i = 1, num_dims
13845 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, xibeg - 1 + i)
13846 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
13847 end do
13848 g_l = 0._wp; g_r = 0._wp;
13849
13850# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13851#if defined(MFC_OpenACC)
13852# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13853!$acc loop seq
13854# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13855#elif defined(MFC_OpenMP)
13856# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13857
13858# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13859#endif
13860 do i = 1, num_fluids
13861 ! Mixture left and right shear modulus
13862 g_l = g_l + alpha_l(i)*gs_rs(i)
13863 g_r = g_r + alpha_r(i)*gs_rs(i)
13864 end do
13865 ! Elastic contribution to energy if G large enough
13866 if (g_l > verysmall .and. g_r > verysmall) then
13867 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, xiend + 1)
13868 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, xiend + 1)
13869 end if
13870
13871# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13872#if defined(MFC_OpenACC)
13873# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13874!$acc loop seq
13875# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13876#elif defined(MFC_OpenMP)
13877# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13878
13879# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13880#endif
13881 do i = 1, b_size - 1
13882 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
13883 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
13884 end do
13885 end if
13886
13887 h_l = (e_l + pres_l)/rho_l
13888 h_r = (e_r + pres_r)/rho_r
13889
13890
13891# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13892 if (avg_state == 1) then
13893# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13894
13895# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13896 rho_avg = sqrt(rho_l*rho_r)
13897# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13898
13899# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13900 vel_avg_rms = 0._wp
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
13905# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13906#if defined(MFC_OpenACC)
13907# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13908!$acc loop seq
13909# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13910#elif defined(MFC_OpenMP)
13911# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13912
13913# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13914#endif
13915# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13916 do i = 1, num_vels
13917# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13918 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
13919# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13920 (sqrt(rho_l) + sqrt(rho_r))**2._wp
13921# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13922 end do
13923# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13924
13925# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13926 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
13927# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13928 (sqrt(rho_l) + sqrt(rho_r))
13929# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13930
13931# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13932 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
13933# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13934 (sqrt(rho_l) + sqrt(rho_r))
13935# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13936
13937# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13938 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
13939# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13940 (sqrt(rho_l) + sqrt(rho_r))**2._wp
13941# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13942
13943# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13944 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
13945# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13946 (sqrt(rho_l) + sqrt(rho_r))
13947# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13948
13949# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13950 if (chemistry) then
13951# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13952 eps = 0.001_wp
13953# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13954 call get_species_enthalpies_rt(t_l, h_il)
13955# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13956 call get_species_enthalpies_rt(t_r, h_ir)
13957# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13958 h_il = h_il*gas_constant/molecular_weights*t_l
13959# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13960 h_ir = h_ir*gas_constant/molecular_weights*t_r
13961# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13962 call get_species_specific_heats_r(t_l, cp_il)
13963# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13964 call get_species_specific_heats_r(t_r, cp_ir)
13965# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13966
13967# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13968 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13969# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13970 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13971# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13972 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13973# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13974 if (abs(t_l - t_r) < eps) then
13975# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13976 ! Case when T_L and T_R are very close
13977# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13978 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13979# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13980 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
13981# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13982 else
13983# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13984 ! Normal calculation when T_L and T_R are sufficiently different
13985# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13986 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13987# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13988 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13989# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13990 end if
13991# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13992 gamma_avg = cp_avg/cv_avg
13993# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13994
13995# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13996 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13997# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13998 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13999# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14000
14001# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14002 end if
14003# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14004
14005# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14006 end if
14007# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14008
14009# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14010 if (avg_state == 2) then
14011# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14012 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14013# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14014 vel_avg_rms = 0._wp
14015# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14016
14017# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14018#if defined(MFC_OpenACC)
14019# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14020!$acc loop seq
14021# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14022#elif defined(MFC_OpenMP)
14023# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14024
14025# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14026#endif
14027# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14028 do i = 1, num_vels
14029# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14030 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14031# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14032 end do
14033# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14034
14035# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14036 h_avg = 5.e-1_wp*(h_l + h_r)
14037# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14038 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14039# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14040 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14041# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14042
14043# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14044 end if
14045# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14046
14047
14048 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
14049 vel_l_rms, 0._wp, c_l, qv_l)
14050
14051 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
14052 vel_r_rms, 0._wp, c_r, qv_r)
14053
14054 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14055 ! variables are placeholders to call the subroutine.
14056 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
14057 vel_avg_rms, 0._wp, c_avg, qv_avg)
14058
14059 if (viscous) then
14060
14061# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14062#if defined(MFC_OpenACC)
14063# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14064!$acc loop seq
14065# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14066#elif defined(MFC_OpenMP)
14067# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14068
14069# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14070#endif
14071 do i = 1, 2
14072 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14073 end do
14074 end if
14075
14076 ! Low Mach correction
14077 if (low_mach == 2) then
14078
14079# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14080 if (riemann_solver == 1 .or. riemann_solver == 5) then
14081# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14082
14083# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14084 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14085# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14086 pcorr = 0._wp
14087# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14088
14089# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14090 if (low_mach == 1) then
14091# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14092 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14093# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14094 end if
14095# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14096
14097# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14098 else if (riemann_solver == 2) then
14099# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14100 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14101# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14102 pcorr = 0._wp
14103# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14104
14105# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14106 if (low_mach == 1) then
14107# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14108 pcorr = rho_l*rho_r* &
14109# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14110 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
14111# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14112 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
14113# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14114 (zcoef - 1._wp)
14115# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14116 else if (low_mach == 2) then
14117# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14118 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))))
14119# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14120 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))))
14121# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14122 vel_l(dir_idx(1)) = vel_l_tmp
14123# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14124 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
14129# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14130
14131 end if
14132
14133 ! COMPUTING THE DIRECT WAVE SPEEDS
14134 if (wave_speeds == 1) then
14135 if (elasticity) then
14136 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
14137 (((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 + &
14138 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
14139 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
14140 (((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 + &
14141 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
14142 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
14143 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
14144 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
14145 rho_r*(s_r - vel_r(dir_idx(1))))
14146 else
14147 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14148 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14149 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
14150 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
14151 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
14152
14153 end if
14154 elseif (wave_speeds == 2) then
14155 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
14156 (vel_l(dir_idx(1)) - &
14157 vel_r(dir_idx(1))))
14158
14159 pres_sr = pres_sl
14160
14161 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
14162 (pres_sl/pres_l - 1._wp)*pres_l/ &
14163 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14164 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
14165 (pres_sr/pres_r - 1._wp)*pres_r/ &
14166 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14167
14168 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14169 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14170
14171 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
14172 (pres_l - pres_r)/ &
14173 (rho_avg*c_avg))
14174 end if
14175
14176 ! follows Einfeldt et al.
14177 ! s_M/P = min/max(0.,s_L/R)
14178 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14179
14180 ! goes with q_star_L/R = xi_L/R * (variable)
14181 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14182 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14183 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14184
14185 ! goes with numerical star velocity in x/y/z directions
14186 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
14187 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
14188 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
14189
14190 ! goes with the numerical velocity in x/y/z directions
14191 ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
14192 xi_mp = -min(0._wp, sign(1._wp, s_l))
14193 xi_pp = max(0._wp, sign(1._wp, s_r))
14194
14195 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
14196 (rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) + &
14197 xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
14198 (rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
14199 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) + &
14200 xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
14201
14202 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + &
14203 xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
14204
14205 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + &
14206 xi_mp*xi_pp*(s_s - vel_r(dir_idx(1)))
14207
14208 ! Low Mach correction
14209 if (low_mach == 1) then
14210
14211# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14212 if (riemann_solver == 1 .or. riemann_solver == 5) then
14213# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14214
14215# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14216 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14217# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14218 pcorr = 0._wp
14219# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14220
14221# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14222 if (low_mach == 1) then
14223# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14224 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14225# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14226 end if
14227# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14228
14229# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14230 else if (riemann_solver == 2) then
14231# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14232 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14233# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14234 pcorr = 0._wp
14235# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14236
14237# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14238 if (low_mach == 1) then
14239# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14240 pcorr = rho_l*rho_r* &
14241# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14242 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
14243# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14244 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
14245# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14246 (zcoef - 1._wp)
14247# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14248 else if (low_mach == 2) then
14249# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14250 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))))
14251# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14252 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))))
14253# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14254 vel_l(dir_idx(1)) = vel_l_tmp
14255# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14256 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
14261# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14262
14263 else
14264 pcorr = 0._wp
14265 end if
14266
14267 ! COMPUTING FLUXES
14268 ! MASS FLUX.
14269
14270# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14271#if defined(MFC_OpenACC)
14272# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14273!$acc loop seq
14274# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14275#elif defined(MFC_OpenMP)
14276# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14277
14278# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14279#endif
14280 do i = 1, contxe
14281 flux_rsz_vf(j, k, l, i) = &
14282 xi_m*ql_prim_rsz_vf(j, k, l, i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + &
14283 xi_p*qr_prim_rsz_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14284 end do
14285
14286 ! MOMENTUM FLUX.
14287 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14288
14289# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14290#if defined(MFC_OpenACC)
14291# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14292!$acc loop seq
14293# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14294#elif defined(MFC_OpenMP)
14295# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14296
14297# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14298#endif
14299 do i = 1, num_dims
14300 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = rho_star*vel_k_star* &
14301 (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 &
14302 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
14303 end do
14304
14305 ! ENERGY FLUX.
14306 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
14307 flux_rsz_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star &
14308 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
14309
14310 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
14311 if (elasticity) then
14312 flux_ene_e = 0._wp;
14313
14314# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14315#if defined(MFC_OpenACC)
14316# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14317!$acc loop seq
14318# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14319#elif defined(MFC_OpenMP)
14320# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14321
14322# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14323#endif
14324 do i = 1, num_dims
14325 ! MOMENTUM ELASTIC FLUX.
14326 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
14327 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) &
14328 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
14329 ! ENERGY ELASTIC FLUX.
14330 flux_ene_e = flux_ene_e - &
14331 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
14332 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
14333 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
14334 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
14335 end do
14336 flux_rsz_vf(j, k, l, e_idx) = flux_rsz_vf(j, k, l, e_idx) + flux_ene_e
14337 end if
14338
14339 ! VOLUME FRACTION FLUX.
14340
14341# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14342#if defined(MFC_OpenACC)
14343# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14344!$acc loop seq
14345# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14346#elif defined(MFC_OpenMP)
14347# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14348
14349# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14350#endif
14351 do i = advxb, advxe
14352 flux_rsz_vf(j, k, l, i) = &
14353 xi_m*ql_prim_rsz_vf(j, k, l, i)*s_s + &
14354 xi_p*qr_prim_rsz_vf(j + 1, k, l, i)*s_s
14355 end do
14356
14357 ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX.
14358
14359# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14360#if defined(MFC_OpenACC)
14361# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14362!$acc loop seq
14363# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14364#elif defined(MFC_OpenMP)
14365# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14366
14367# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14368#endif
14369 do i = 1, num_dims
14370 vel_src_rsz_vf(j, k, l, dir_idx(i)) = &
14371 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)))) + &
14372 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))))
14373 end do
14374
14375 ! INTERNAL ENERGIES ADVECTION FLUX.
14376 ! K-th pressure and velocity in preparation for the internal energy flux
14377
14378# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14379#if defined(MFC_OpenACC)
14380# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14381!$acc loop seq
14382# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14383#elif defined(MFC_OpenMP)
14384# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14385
14386# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14387#endif
14388 do i = 1, num_fluids
14389 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))* &
14390 xi_l**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) + &
14391 xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i)))* &
14392 xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) + pres_r)
14393
14394 flux_rsz_vf(j, k, l, i + intxb - 1) = &
14395 ((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))* &
14396 (gammas(i)*p_k_star + pi_infs(i)) + &
14397 (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))* &
14398 qvs(i))*vel_k_star &
14399 + (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))
14400 end do
14401
14402 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
14403
14404 ! HYPOELASTIC STRESS EVOLUTION FLUX.
14405 if (hypoelasticity) then
14406
14407# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14408#if defined(MFC_OpenACC)
14409# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14410!$acc loop seq
14411# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14412#elif defined(MFC_OpenMP)
14413# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14414
14415# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14416#endif
14417 do i = 1, strxe - strxb + 1
14418 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
14419 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)) + &
14420 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))
14421 end do
14422 end if
14423
14424 ! REFERENCE MAP FLUX.
14425 if (hyperelasticity) then
14426
14427# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14428#if defined(MFC_OpenACC)
14429# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14430!$acc loop seq
14431# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14432#elif defined(MFC_OpenMP)
14433# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14434
14435# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14436#endif
14437 do i = 1, num_dims
14438 flux_rsz_vf(j, k, l, xibeg - 1 + i) = &
14439 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
14440 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
14441 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
14442 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
14443 end do
14444 end if
14445
14446 ! COLOR FUNCTION FLUX
14447 if (surface_tension) then
14448 flux_rsz_vf(j, k, l, c_idx) = &
14449 (xi_m*ql_prim_rsz_vf(j, k, l, c_idx) + &
14450 xi_p*qr_prim_rsz_vf(j + 1, k, l, c_idx))*s_s
14451 end if
14452
14453 ! Geometrical source flux for cylindrical coordinates
14454# 2478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14455# 2479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14456 if (grid_geometry == 3) then
14457
14458# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14459#if defined(MFC_OpenACC)
14460# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14461!$acc loop seq
14462# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14463#elif defined(MFC_OpenMP)
14464# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14465
14466# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14467#endif
14468 do i = 1, sys_size
14469 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
14470 end do
14471 flux_gsrc_rsz_vf(j, k, l, momxb - 1 + dir_idx(1)) = &
14472 flux_gsrc_rsz_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_star
14473
14474 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
14475 end if
14476# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14477
14478 end do
14479 end do
14480 end do
14481
14482# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14483
14484# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14485#if defined(MFC_OpenACC)
14486# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14487!$acc end parallel loop
14488# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14489#elif defined(MFC_OpenMP)
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
14494# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14495!$omp end target teams loop
14496# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14497#endif
14498# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14499
14500
14501 elseif (model_eqns == 4) then
14502 !ME4
14503
14504# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14505
14506# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14507#if defined(MFC_OpenACC)
14508# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14509!$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)
14510# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14511#elif defined(MFC_OpenMP)
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
14518# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14519!$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)
14520# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14521#endif
14522# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14523
14524 do l = is3%beg, is3%end
14525 do k = is2%beg, is2%end
14526 do j = is1%beg, is1%end
14527
14528 vel_l_rms = 0._wp; vel_r_rms = 0._wp
14529 rho_l = 0._wp; rho_r = 0._wp
14530 gamma_l = 0._wp; gamma_r = 0._wp
14531 pi_inf_l = 0._wp; pi_inf_r = 0._wp
14532 qv_l = 0._wp; qv_r = 0._wp
14533
14534
14535# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14536#if defined(MFC_OpenACC)
14537# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14538!$acc loop seq
14539# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14540#elif defined(MFC_OpenMP)
14541# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14542
14543# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14544#endif
14545 do i = 1, contxe
14546 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
14547 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
14548 end do
14549
14550
14551# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14552#if defined(MFC_OpenACC)
14553# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14554!$acc loop seq
14555# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14556#elif defined(MFC_OpenMP)
14557# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14558
14559# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14560#endif
14561 do i = 1, num_dims
14562 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
14563 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
14564 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
14565 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
14566 end do
14567
14568
14569# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14570#if defined(MFC_OpenACC)
14571# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14572!$acc loop seq
14573# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14574#elif defined(MFC_OpenMP)
14575# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14576
14577# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14578#endif
14579 do i = 1, num_fluids
14580 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
14581 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
14582 end do
14583
14584# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14585#if defined(MFC_OpenACC)
14586# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14587!$acc loop seq
14588# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14589#elif defined(MFC_OpenMP)
14590# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14591
14592# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14593#endif
14594 do i = 1, num_fluids
14595 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
14596 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
14597 end do
14598
14599
14600# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14601#if defined(MFC_OpenACC)
14602# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14603!$acc loop seq
14604# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14605#elif defined(MFC_OpenMP)
14606# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14607
14608# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14609#endif
14610 do i = 1, num_fluids
14611 rho_l = rho_l + alpha_rho_l(i)
14612 gamma_l = gamma_l + alpha_l(i)*gammas(i)
14613 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
14614 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
14615
14616 rho_r = rho_r + alpha_rho_r(i)
14617 gamma_r = gamma_r + alpha_r(i)*gammas(i)
14618 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
14619 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
14620 end do
14621
14622 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
14623 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
14624
14625 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
14626 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
14627
14628 h_l = (e_l + pres_l)/rho_l
14629 h_r = (e_r + pres_r)/rho_r
14630
14631
14632# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14633 if (avg_state == 1) then
14634# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14635
14636# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14637 rho_avg = sqrt(rho_l*rho_r)
14638# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14639
14640# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14641 vel_avg_rms = 0._wp
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
14646# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14647#if defined(MFC_OpenACC)
14648# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14649!$acc loop seq
14650# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14651#elif defined(MFC_OpenMP)
14652# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14653
14654# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14655#endif
14656# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14657 do i = 1, num_vels
14658# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14659 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
14660# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14661 (sqrt(rho_l) + sqrt(rho_r))**2._wp
14662# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14663 end do
14664# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14665
14666# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14667 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
14668# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14669 (sqrt(rho_l) + sqrt(rho_r))
14670# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14671
14672# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14673 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
14674# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14675 (sqrt(rho_l) + sqrt(rho_r))
14676# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14677
14678# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14679 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
14680# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14681 (sqrt(rho_l) + sqrt(rho_r))**2._wp
14682# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14683
14684# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14685 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
14686# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14687 (sqrt(rho_l) + sqrt(rho_r))
14688# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14689
14690# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14691 if (chemistry) then
14692# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14693 eps = 0.001_wp
14694# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14695 call get_species_enthalpies_rt(t_l, h_il)
14696# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14697 call get_species_enthalpies_rt(t_r, h_ir)
14698# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14699 h_il = h_il*gas_constant/molecular_weights*t_l
14700# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14701 h_ir = h_ir*gas_constant/molecular_weights*t_r
14702# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14703 call get_species_specific_heats_r(t_l, cp_il)
14704# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14705 call get_species_specific_heats_r(t_r, cp_ir)
14706# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14707
14708# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14709 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
14710# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14711 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
14712# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14713 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
14714# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14715 if (abs(t_l - t_r) < eps) then
14716# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14717 ! Case when T_L and T_R are very close
14718# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14719 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
14720# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14721 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
14722# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14723 else
14724# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14725 ! Normal calculation when T_L and T_R are sufficiently different
14726# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14727 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
14728# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14729 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
14730# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14731 end if
14732# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14733 gamma_avg = cp_avg/cv_avg
14734# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14735
14736# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14737 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
14738# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14739 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
14740# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14741
14742# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14743 end if
14744# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14745
14746# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14747 end if
14748# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14749
14750# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14751 if (avg_state == 2) then
14752# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14753 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14754# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14755 vel_avg_rms = 0._wp
14756# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14757
14758# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14759#if defined(MFC_OpenACC)
14760# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14761!$acc loop seq
14762# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14763#elif defined(MFC_OpenMP)
14764# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14765
14766# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14767#endif
14768# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14769 do i = 1, num_vels
14770# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14771 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14772# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14773 end do
14774# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14775
14776# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14777 h_avg = 5.e-1_wp*(h_l + h_r)
14778# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14779 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14780# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14781 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14782# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14783
14784# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14785 end if
14786# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14787
14788
14789 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
14790 vel_l_rms, 0._wp, c_l, qv_l)
14791
14792 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
14793 vel_r_rms, 0._wp, c_r, qv_r)
14794
14795 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14796 ! variables are placeholders to call the subroutine.
14797
14798 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
14799 vel_avg_rms, 0._wp, c_avg, qv_avg)
14800
14801 if (wave_speeds == 1) then
14802 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14803 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14804
14805 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
14806 (s_l - vel_l(dir_idx(1))) - &
14807 rho_r*vel_r(dir_idx(1))* &
14808 (s_r - vel_r(dir_idx(1)))) &
14809 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
14810 rho_r*(s_r - vel_r(dir_idx(1))))
14811 elseif (wave_speeds == 2) then
14812 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
14813 (vel_l(dir_idx(1)) - &
14814 vel_r(dir_idx(1))))
14815
14816 pres_sr = pres_sl
14817
14818 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
14819 (pres_sl/pres_l - 1._wp)*pres_l/ &
14820 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14821 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
14822 (pres_sr/pres_r - 1._wp)*pres_r/ &
14823 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14824
14825 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14826 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14827
14828 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
14829 (pres_l - pres_r)/ &
14830 (rho_avg*c_avg))
14831 end if
14832
14833 ! follows Einfeldt et al.
14834 ! s_M/P = min/max(0.,s_L/R)
14835 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14836
14837 ! goes with q_star_L/R = xi_L/R * (variable)
14838 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14839 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14840 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14841
14842 ! goes with numerical velocity in x/y/z directions
14843 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
14844 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14845 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14846
14847
14848# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14849#if defined(MFC_OpenACC)
14850# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14851!$acc loop seq
14852# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14853#elif defined(MFC_OpenMP)
14854# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14855
14856# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14857#endif
14858 do i = 1, contxe
14859 flux_rsz_vf(j, k, l, i) = &
14860 xi_m*alpha_rho_l(i) &
14861 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14862 + xi_p*alpha_rho_r(i) &
14863 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14864 end do
14865
14866 ! Momentum flux.
14867 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14868
14869# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14870#if defined(MFC_OpenACC)
14871# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14872!$acc loop seq
14873# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14874#elif defined(MFC_OpenMP)
14875# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14876
14877# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14878#endif
14879 do i = 1, num_dims
14880 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
14881 xi_m*(rho_l*(vel_l(dir_idx(1))* &
14882 vel_l(dir_idx(i)) + &
14883 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
14884 (1._wp - dir_flg(dir_idx(i)))* &
14885 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
14886 dir_flg(dir_idx(i))*pres_l) &
14887 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
14888 vel_r(dir_idx(i)) + &
14889 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
14890 (1._wp - dir_flg(dir_idx(i)))* &
14891 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
14892 dir_flg(dir_idx(i))*pres_r)
14893 end do
14894
14895 if (bubbles_euler) then
14896 ! Put p_tilde in
14897
14898# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14899#if defined(MFC_OpenACC)
14900# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14901!$acc loop seq
14902# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14903#elif defined(MFC_OpenMP)
14904# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14905
14906# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14907#endif
14908 do i = 1, num_dims
14909 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
14910 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) + &
14911 xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
14912 + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
14913 end do
14914 end if
14915
14916 flux_rsz_vf(j, k, l, e_idx) = 0._wp
14917
14918
14919# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14920#if defined(MFC_OpenACC)
14921# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14922!$acc loop seq
14923# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14924#elif defined(MFC_OpenMP)
14925# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14926
14927# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14928#endif
14929 do i = alf_idx, alf_idx !only advect the void fraction
14930 flux_rsz_vf(j, k, l, i) = &
14931 xi_m*ql_prim_rsz_vf(j, k, l, i) &
14932 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14933 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
14934 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14935 end do
14936
14937 ! Source for volume fraction advection equation
14938
14939# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14940#if defined(MFC_OpenACC)
14941# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14942!$acc loop seq
14943# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14944#elif defined(MFC_OpenMP)
14945# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14946
14947# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14948#endif
14949 do i = 1, num_dims
14950
14951 vel_src_rsz_vf(j, k, l, dir_idx(i)) = 0._wp
14952 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
14953 end do
14954
14955 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
14956
14957 ! Add advection flux for bubble variables
14958 if (bubbles_euler) then
14959
14960# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14961#if defined(MFC_OpenACC)
14962# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14963!$acc loop seq
14964# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14965#elif defined(MFC_OpenMP)
14966# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14967
14968# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14969#endif
14970 do i = bubxb, bubxe
14971 flux_rsz_vf(j, k, l, i) = &
14972 xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, i) &
14973 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14974 + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, i) &
14975 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14976 end do
14977 end if
14978
14979 ! Geometrical source flux for cylindrical coordinates
14980
14981# 2716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14982# 2717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14983 if (grid_geometry == 3) then
14984
14985# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14986#if defined(MFC_OpenACC)
14987# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14988!$acc loop seq
14989# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14990#elif defined(MFC_OpenMP)
14991# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14992
14993# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14994#endif
14995 do i = 1, sys_size
14996 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
14997 end do
14998 flux_gsrc_rsz_vf(j, k, l, momxb + 1) = &
14999 -xi_m*(rho_l*(vel_l(dir_idx(1))* &
15000 vel_l(dir_idx(1)) + &
15001 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
15002 (1._wp - dir_flg(dir_idx(1)))* &
15003 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15004 - xi_p*(rho_r*(vel_r(dir_idx(1))* &
15005 vel_r(dir_idx(1)) + &
15006 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
15007 (1._wp - dir_flg(dir_idx(1)))* &
15008 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15009 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
15010 end if
15011# 2736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15012 end do
15013 end do
15014 end do
15015
15016# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15017
15018# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15019#if defined(MFC_OpenACC)
15020# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15021!$acc end parallel loop
15022# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15023#elif defined(MFC_OpenMP)
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
15028# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15029!$omp end target teams loop
15030# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15031#endif
15032# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15033
15034
15035 elseif (model_eqns == 2 .and. bubbles_euler) then
15036
15037# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15038
15039# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15040#if defined(MFC_OpenACC)
15041# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15042!$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)
15043# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15044#elif defined(MFC_OpenMP)
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
15051# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15052!$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)
15053# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15054#endif
15055# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15056
15057 do l = is3%beg, is3%end
15058 do k = is2%beg, is2%end
15059 do j = is1%beg, is1%end
15060
15061 vel_l_rms = 0._wp; vel_r_rms = 0._wp
15062 rho_l = 0._wp; rho_r = 0._wp
15063 gamma_l = 0._wp; gamma_r = 0._wp
15064 pi_inf_l = 0._wp; pi_inf_r = 0._wp
15065 qv_l = 0._wp; qv_r = 0._wp
15066
15067
15068# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15069#if defined(MFC_OpenACC)
15070# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15071!$acc loop seq
15072# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15073#elif defined(MFC_OpenMP)
15074# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15075
15076# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15077#endif
15078 do i = 1, num_fluids
15079 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
15080 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15081 end do
15082
15083 vel_l_rms = 0._wp; vel_r_rms = 0._wp
15084
15085
15086# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15087#if defined(MFC_OpenACC)
15088# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15089!$acc loop seq
15090# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15091#elif defined(MFC_OpenMP)
15092# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15093
15094# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15095#endif
15096 do i = 1, num_dims
15097 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
15098 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
15099 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
15100 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
15101 end do
15102
15103 ! Retain this in the refactor
15104 if (mpp_lim .and. (num_fluids > 2)) then
15105
15106# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15107#if defined(MFC_OpenACC)
15108# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15109!$acc loop seq
15110# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15111#elif defined(MFC_OpenMP)
15112# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15113
15114# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15115#endif
15116 do i = 1, num_fluids
15117 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
15118 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
15119 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
15120 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
15121 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
15122 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
15123 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
15124 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
15125 end do
15126 else if (num_fluids > 2) then
15127
15128# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15129#if defined(MFC_OpenACC)
15130# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15131!$acc loop seq
15132# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15133#elif defined(MFC_OpenMP)
15134# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15135
15136# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15137#endif
15138 do i = 1, num_fluids - 1
15139 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
15140 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
15141 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
15142 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
15143 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
15144 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
15145 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
15146 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
15147 end do
15148 else
15149 rho_l = ql_prim_rsz_vf(j, k, l, 1)
15150 gamma_l = gammas(1)
15151 pi_inf_l = pi_infs(1)
15152 qv_l = qvs(1)
15153 rho_r = qr_prim_rsz_vf(j + 1, k, l, 1)
15154 gamma_r = gammas(1)
15155 pi_inf_r = pi_infs(1)
15156 qv_r = qvs(1)
15157 end if
15158
15159 if (viscous) then
15160 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
15161
15162# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15163#if defined(MFC_OpenACC)
15164# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15165!$acc loop seq
15166# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15167#elif defined(MFC_OpenMP)
15168# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15169
15170# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15171#endif
15172 do i = 1, 2
15173 re_l(i) = dflt_real
15174 re_r(i) = dflt_real
15175
15176 if (re_size(i) > 0) re_l(i) = 0._wp
15177 if (re_size(i) > 0) re_r(i) = 0._wp
15178
15179
15180# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15181#if defined(MFC_OpenACC)
15182# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15183!$acc loop seq
15184# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15185#elif defined(MFC_OpenMP)
15186# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15187
15188# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15189#endif
15190 do q = 1, re_size(i)
15191 re_l(i) = (1._wp - ql_prim_rsz_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
15192 + re_l(i)
15193 re_r(i) = (1._wp - qr_prim_rsz_vf(j + 1, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
15194 + re_r(i)
15195 end do
15196
15197 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
15198 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
15199
15200 end do
15201 end if
15202 end if
15203
15204 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
15205 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
15206
15207 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
15208 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
15209
15210 h_l = (e_l + pres_l)/rho_l
15211 h_r = (e_r + pres_r)/rho_r
15212
15213 if (avg_state == 2) then
15214
15215# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15216#if defined(MFC_OpenACC)
15217# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15218!$acc loop seq
15219# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15220#elif defined(MFC_OpenMP)
15221# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15222
15223# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15224#endif
15225 do i = 1, nb
15226 r0_l(i) = ql_prim_rsz_vf(j, k, l, rs(i))
15227 r0_r(i) = qr_prim_rsz_vf(j + 1, k, l, rs(i))
15228
15229 v0_l(i) = ql_prim_rsz_vf(j, k, l, vs(i))
15230 v0_r(i) = qr_prim_rsz_vf(j + 1, k, l, vs(i))
15231 if (.not. polytropic .and. .not. qbmm) then
15232 p0_l(i) = ql_prim_rsz_vf(j, k, l, ps(i))
15233 p0_r(i) = qr_prim_rsz_vf(j + 1, k, l, ps(i))
15234 end if
15235 end do
15236
15237 if (.not. qbmm) then
15238 if (adv_n) then
15239 nbub_l = ql_prim_rsz_vf(j, k, l, n_idx)
15240 nbub_r = qr_prim_rsz_vf(j + 1, k, l, n_idx)
15241 else
15242 nbub_l = 0._wp
15243 nbub_r = 0._wp
15244
15245# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15246#if defined(MFC_OpenACC)
15247# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15248!$acc loop seq
15249# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15250#elif defined(MFC_OpenMP)
15251# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15252
15253# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15254#endif
15255 do i = 1, nb
15256 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
15257 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
15258 end do
15259
15260 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsz_vf(j, k, l, e_idx + num_fluids)/nbub_l
15261 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsz_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
15262 end if
15263 else
15264 !nb stored in 0th moment of first R0 bin in variable conversion module
15265 nbub_l = ql_prim_rsz_vf(j, k, l, bubxb)
15266 nbub_r = qr_prim_rsz_vf(j + 1, k, l, bubxb)
15267 end if
15268
15269
15270# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15271#if defined(MFC_OpenACC)
15272# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15273!$acc loop seq
15274# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15275#elif defined(MFC_OpenMP)
15276# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15277
15278# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15279#endif
15280 do i = 1, nb
15281 if (.not. qbmm) then
15282 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
15283 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
15284 end if
15285 end do
15286
15287 if (qbmm) then
15288 pbwr3lbar = mom_sp_rsz_vf(j, k, l, 4)
15289 pbwr3rbar = mom_sp_rsz_vf(j + 1, k, l, 4)
15290
15291 r3lbar = mom_sp_rsz_vf(j, k, l, 1)
15292 r3rbar = mom_sp_rsz_vf(j + 1, k, l, 1)
15293
15294 r3v2lbar = mom_sp_rsz_vf(j, k, l, 3)
15295 r3v2rbar = mom_sp_rsz_vf(j + 1, k, l, 3)
15296 else
15297
15298 pbwr3lbar = 0._wp
15299 pbwr3rbar = 0._wp
15300
15301 r3lbar = 0._wp
15302 r3rbar = 0._wp
15303
15304 r3v2lbar = 0._wp
15305 r3v2rbar = 0._wp
15306
15307
15308# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15309#if defined(MFC_OpenACC)
15310# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15311!$acc loop seq
15312# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15313#elif defined(MFC_OpenMP)
15314# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15315
15316# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15317#endif
15318 do i = 1, nb
15319 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
15320 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
15321
15322 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
15323 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
15324
15325 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
15326 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
15327 end do
15328 end if
15329
15330 rho_avg = 5.e-1_wp*(rho_l + rho_r)
15331 h_avg = 5.e-1_wp*(h_l + h_r)
15332 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
15333 qv_avg = 5.e-1_wp*(qv_l + qv_r)
15334 vel_avg_rms = 0._wp
15335
15336
15337# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15338#if defined(MFC_OpenACC)
15339# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15340!$acc loop seq
15341# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15342#elif defined(MFC_OpenMP)
15343# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15344
15345# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15346#endif
15347 do i = 1, num_dims
15348 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
15349 end do
15350
15351 end if
15352
15353 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
15354 vel_l_rms, 0._wp, c_l, qv_l)
15355
15356 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
15357 vel_r_rms, 0._wp, c_r, qv_r)
15358
15359 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
15360 ! variables are placeholders to call the subroutine.
15361 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
15362 vel_avg_rms, 0._wp, c_avg, qv_avg)
15363
15364 if (viscous) then
15365
15366# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15367#if defined(MFC_OpenACC)
15368# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15369!$acc loop seq
15370# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15371#elif defined(MFC_OpenMP)
15372# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15373
15374# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15375#endif
15376 do i = 1, 2
15377 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
15378 end do
15379 end if
15380
15381 ! Low Mach correction
15382 if (low_mach == 2) then
15383
15384# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15385 if (riemann_solver == 1 .or. riemann_solver == 5) then
15386# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15387
15388# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15389 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15390# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15391 pcorr = 0._wp
15392# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15393
15394# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15395 if (low_mach == 1) then
15396# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15397 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
15398# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15399 end if
15400# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15401
15402# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15403 else if (riemann_solver == 2) then
15404# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15405 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15406# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15407 pcorr = 0._wp
15408# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15409
15410# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15411 if (low_mach == 1) then
15412# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15413 pcorr = rho_l*rho_r* &
15414# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15415 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
15416# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15417 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
15418# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15419 (zcoef - 1._wp)
15420# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15421 else if (low_mach == 2) then
15422# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15423 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))))
15424# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15425 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))))
15426# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15427 vel_l(dir_idx(1)) = vel_l_tmp
15428# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15429 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
15434# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15435
15436 end if
15437
15438 if (wave_speeds == 1) then
15439 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
15440 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
15441
15442 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
15443 (s_l - vel_l(dir_idx(1))) - &
15444 rho_r*vel_r(dir_idx(1))* &
15445 (s_r - vel_r(dir_idx(1)))) &
15446 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
15447 rho_r*(s_r - vel_r(dir_idx(1))))
15448 elseif (wave_speeds == 2) then
15449 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
15450 (vel_l(dir_idx(1)) - &
15451 vel_r(dir_idx(1))))
15452
15453 pres_sr = pres_sl
15454
15455 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
15456 (pres_sl/pres_l - 1._wp)*pres_l/ &
15457 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
15458 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
15459 (pres_sr/pres_r - 1._wp)*pres_r/ &
15460 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
15461
15462 s_l = vel_l(dir_idx(1)) - c_l*ms_l
15463 s_r = vel_r(dir_idx(1)) + c_r*ms_r
15464
15465 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
15466 (pres_l - pres_r)/ &
15467 (rho_avg*c_avg))
15468 end if
15469
15470 ! follows Einfeldt et al.
15471 ! s_M/P = min/max(0.,s_L/R)
15472 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
15473
15474 ! goes with q_star_L/R = xi_L/R * (variable)
15475 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
15476 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
15477 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
15478
15479 ! goes with numerical velocity in x/y/z directions
15480 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
15481 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
15482 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
15483
15484 ! Low Mach correction
15485 if (low_mach == 1) then
15486
15487# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15488 if (riemann_solver == 1 .or. riemann_solver == 5) then
15489# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15490
15491# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15492 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15493# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15494 pcorr = 0._wp
15495# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15496
15497# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15498 if (low_mach == 1) then
15499# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15500 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
15501# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15502 end if
15503# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15504
15505# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15506 else if (riemann_solver == 2) then
15507# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15508 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15509# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15510 pcorr = 0._wp
15511# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15512
15513# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15514 if (low_mach == 1) then
15515# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15516 pcorr = rho_l*rho_r* &
15517# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15518 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
15519# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15520 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
15521# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15522 (zcoef - 1._wp)
15523# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15524 else if (low_mach == 2) then
15525# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15526 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))))
15527# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15528 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))))
15529# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15530 vel_l(dir_idx(1)) = vel_l_tmp
15531# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15532 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
15537# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15538
15539 else
15540 pcorr = 0._wp
15541 end if
15542
15543
15544# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15545#if defined(MFC_OpenACC)
15546# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15547!$acc loop seq
15548# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15549#elif defined(MFC_OpenMP)
15550# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15551
15552# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15553#endif
15554 do i = 1, contxe
15555 flux_rsz_vf(j, k, l, i) = &
15556 xi_m*ql_prim_rsz_vf(j, k, l, i) &
15557 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15558 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
15559 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15560 end do
15561
15562 if (bubbles_euler .and. (num_fluids > 1)) then
15563 ! Kill mass transport @ gas density
15564 flux_rsz_vf(j, k, l, contxe) = 0._wp
15565 end if
15566
15567 ! Momentum flux.
15568 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
15569
15570 ! Include p_tilde
15571
15572 if (avg_state == 2) then
15573 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
15574 pres_l = pres_l - alpha_l(num_fluids)*pres_l
15575 else
15576 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - &
15577 rho_l*r3v2lbar/r3lbar)
15578 end if
15579
15580 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
15581 pres_r = pres_r - alpha_r(num_fluids)*pres_r
15582 else
15583 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - &
15584 rho_r*r3v2rbar/r3rbar)
15585 end if
15586 end if
15587
15588
15589# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15590#if defined(MFC_OpenACC)
15591# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15592!$acc loop seq
15593# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15594#elif defined(MFC_OpenMP)
15595# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15596
15597# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15598#endif
15599 do i = 1, num_dims
15600 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
15601 xi_m*(rho_l*(vel_l(dir_idx(1))* &
15602 vel_l(dir_idx(i)) + &
15603 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
15604 (1._wp - dir_flg(dir_idx(i)))* &
15605 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
15606 dir_flg(dir_idx(i))*(pres_l)) &
15607 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
15608 vel_r(dir_idx(i)) + &
15609 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
15610 (1._wp - dir_flg(dir_idx(i)))* &
15611 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
15612 dir_flg(dir_idx(i))*(pres_r)) &
15613 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
15614 end do
15615
15616 ! Energy flux.
15617 ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
15618 flux_rsz_vf(j, k, l, e_idx) = &
15619 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
15620 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
15621 (rho_l*s_s + (pres_l)/ &
15622 (s_l - vel_l(dir_idx(1))))) - e_l)) &
15623 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
15624 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
15625 (rho_r*s_s + (pres_r)/ &
15626 (s_r - vel_r(dir_idx(1))))) - e_r)) &
15627 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
15628
15629 ! Volume fraction flux
15630
15631# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15632#if defined(MFC_OpenACC)
15633# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15634!$acc loop seq
15635# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15636#elif defined(MFC_OpenMP)
15637# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15638
15639# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15640#endif
15641 do i = advxb, advxe
15642 flux_rsz_vf(j, k, l, i) = &
15643 xi_m*ql_prim_rsz_vf(j, k, l, i) &
15644 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15645 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
15646 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15647 end do
15648
15649 ! Source for volume fraction advection equation
15650
15651# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15652#if defined(MFC_OpenACC)
15653# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15654!$acc loop seq
15655# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15656#elif defined(MFC_OpenMP)
15657# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15658
15659# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15660#endif
15661 do i = 1, num_dims
15662 vel_src_rsz_vf(j, k, l, dir_idx(i)) = &
15663 xi_m*(vel_l(dir_idx(i)) + &
15664 dir_flg(dir_idx(i))* &
15665 s_m*(xi_l - 1._wp)) &
15666 + xi_p*(vel_r(dir_idx(i)) + &
15667 dir_flg(dir_idx(i))* &
15668 s_p*(xi_r - 1._wp))
15669
15670 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
15671 end do
15672
15673 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
15674
15675 ! Add advection flux for bubble variables
15676
15677# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15678#if defined(MFC_OpenACC)
15679# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15680!$acc loop seq
15681# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15682#elif defined(MFC_OpenMP)
15683# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15684
15685# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15686#endif
15687 do i = bubxb, bubxe
15688 flux_rsz_vf(j, k, l, i) = &
15689 xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, i) &
15690 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15691 + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, i) &
15692 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15693 end do
15694
15695 if (qbmm) then
15696 flux_rsz_vf(j, k, l, bubxb) = &
15697 xi_m*nbub_l &
15698 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15699 + xi_p*nbub_r &
15700 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15701 end if
15702
15703 if (adv_n) then
15704 flux_rsz_vf(j, k, l, n_idx) = &
15705 xi_m*nbub_l &
15706 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15707 + xi_p*nbub_r &
15708 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15709 end if
15710
15711 ! Geometrical source flux for cylindrical coordinates
15712# 3150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15713# 3151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15714 if (grid_geometry == 3) then
15715
15716# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15717#if defined(MFC_OpenACC)
15718# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15719!$acc loop seq
15720# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15721#elif defined(MFC_OpenMP)
15722# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15723
15724# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15725#endif
15726 do i = 1, sys_size
15727 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
15728 end do
15729
15730 flux_gsrc_rsz_vf(j, k, l, momxb + 1) = &
15731 -xi_m*(rho_l*(vel_l(dir_idx(1))* &
15732 vel_l(dir_idx(1)) + &
15733 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
15734 (1._wp - dir_flg(dir_idx(1)))* &
15735 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15736 - xi_p*(rho_r*(vel_r(dir_idx(1))* &
15737 vel_r(dir_idx(1)) + &
15738 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
15739 (1._wp - dir_flg(dir_idx(1)))* &
15740 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15741 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
15742
15743 end if
15744# 3172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15745 end do
15746 end do
15747 end do
15748
15749# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15750
15751# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15752#if defined(MFC_OpenACC)
15753# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15754!$acc end parallel loop
15755# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15756#elif defined(MFC_OpenMP)
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
15761# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15762!$omp end target teams loop
15763# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15764#endif
15765# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15766
15767 else
15768 ! 5-EQUATION MODEL WITH HLLC
15769
15770# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15771
15772# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15773#if defined(MFC_OpenACC)
15774# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15775!$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)
15776# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15777#elif defined(MFC_OpenMP)
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
15784# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15785!$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)
15786# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15787#endif
15788# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15789
15790 do l = is3%beg, is3%end
15791 do k = is2%beg, is2%end
15792 do j = is1%beg, is1%end
15793
15794 vel_l_rms = 0._wp; vel_r_rms = 0._wp
15795 rho_l = 0._wp; rho_r = 0._wp
15796 gamma_l = 0._wp; gamma_r = 0._wp
15797 pi_inf_l = 0._wp; pi_inf_r = 0._wp
15798 qv_l = 0._wp; qv_r = 0._wp
15799 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
15800
15801
15802# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15803#if defined(MFC_OpenACC)
15804# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15805!$acc loop seq
15806# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15807#elif defined(MFC_OpenMP)
15808# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15809
15810# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15811#endif
15812 do i = 1, num_fluids
15813 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
15814 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15815 end do
15816
15817
15818# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15819#if defined(MFC_OpenACC)
15820# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15821!$acc loop seq
15822# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15823#elif defined(MFC_OpenMP)
15824# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15825
15826# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15827#endif
15828 do i = 1, num_dims
15829 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
15830 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
15831 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
15832 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
15833 end do
15834
15835 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
15836 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
15837
15838 ! Change this by splitting it into the cases
15839 ! present in the bubbles_euler
15840 if (mpp_lim) then
15841
15842# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15843#if defined(MFC_OpenACC)
15844# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15845!$acc loop seq
15846# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15847#elif defined(MFC_OpenMP)
15848# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15849
15850# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15851#endif
15852 do i = 1, num_fluids
15853 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
15854 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)
15855 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
15856 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)
15857 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, e_idx + i)
15858 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15859 end do
15860
15861
15862# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15863#if defined(MFC_OpenACC)
15864# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15865!$acc loop seq
15866# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15867#elif defined(MFC_OpenMP)
15868# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15869
15870# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15871#endif
15872 do i = 1, num_fluids
15873 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)
15874 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)
15875 end do
15876 end if
15877
15878
15879# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15880#if defined(MFC_OpenACC)
15881# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15882!$acc loop seq
15883# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15884#elif defined(MFC_OpenMP)
15885# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15886
15887# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15888#endif
15889 do i = 1, num_fluids
15890 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
15891 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
15892 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
15893 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
15894
15895 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
15896 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
15897 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
15898 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
15899 end do
15900
15901 re_max = 0
15902 if (re_size(1) > 0) re_max = 1
15903 if (re_size(2) > 0) re_max = 2
15904
15905 if (viscous) then
15906
15907# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15908#if defined(MFC_OpenACC)
15909# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15910!$acc loop seq
15911# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15912#elif defined(MFC_OpenMP)
15913# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15914
15915# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15916#endif
15917 do i = 1, re_max
15918 re_l(i) = 0._wp
15919 re_r(i) = 0._wp
15920
15921
15922# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15923#if defined(MFC_OpenACC)
15924# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15925!$acc loop seq
15926# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15927#elif defined(MFC_OpenMP)
15928# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15929
15930# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15931#endif
15932 do q = 1, re_size(i)
15933 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
15934 + re_l(i)
15935 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
15936 + re_r(i)
15937 end do
15938
15939 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
15940 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
15941 end do
15942 end if
15943
15944 if (chemistry) then
15945 c_sum_yi_phi = 0.0_wp
15946
15947# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15948#if defined(MFC_OpenACC)
15949# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15950!$acc loop seq
15951# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15952#elif defined(MFC_OpenMP)
15953# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15954
15955# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15956#endif
15957 do i = chemxb, chemxe
15958 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
15959 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
15960 end do
15961
15962 call get_mixture_molecular_weight(ys_l, mw_l)
15963 call get_mixture_molecular_weight(ys_r, mw_r)
15964
15965# 3278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15966 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
15967 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
15968# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15969
15970 r_gas_l = gas_constant/mw_l
15971 r_gas_r = gas_constant/mw_r
15972
15973 t_l = pres_l/rho_l/r_gas_l
15974 t_r = pres_r/rho_r/r_gas_r
15975
15976 call get_species_specific_heats_r(t_l, cp_il)
15977 call get_species_specific_heats_r(t_r, cp_ir)
15978
15979 if (chem_params%gamma_method == 1) then
15980 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
15981 gamma_il = cp_il/(cp_il - 1.0_wp)
15982 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
15983
15984 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
15985 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
15986 else if (chem_params%gamma_method == 2) then
15987 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
15988 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
15989 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
15990 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
15991 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
15992
15993 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
15994 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
15995 end if
15996
15997 call get_mixture_energy_mass(t_l, ys_l, e_l)
15998 call get_mixture_energy_mass(t_r, ys_r, e_r)
15999
16000 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
16001 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
16002 h_l = (e_l + pres_l)/rho_l
16003 h_r = (e_r + pres_r)/rho_r
16004 else
16005 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
16006 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
16007
16008 h_l = (e_l + pres_l)/rho_l
16009 h_r = (e_r + pres_r)/rho_r
16010 end if
16011
16012 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
16013 if (hypoelasticity) then
16014
16015# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16016#if defined(MFC_OpenACC)
16017# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16018!$acc loop seq
16019# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16020#elif defined(MFC_OpenMP)
16021# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16022
16023# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16024#endif
16025 do i = 1, strxe - strxb + 1
16026 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
16027 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
16028 end do
16029 g_l = 0._wp
16030 g_r = 0._wp
16031
16032# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16033#if defined(MFC_OpenACC)
16034# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16035!$acc loop seq
16036# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16037#elif defined(MFC_OpenMP)
16038# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16039
16040# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16041#endif
16042 do i = 1, num_fluids
16043 g_l = g_l + alpha_l(i)*gs_rs(i)
16044 g_r = g_r + alpha_r(i)*gs_rs(i)
16045 end do
16046
16047# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16048#if defined(MFC_OpenACC)
16049# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16050!$acc loop seq
16051# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16052#elif defined(MFC_OpenMP)
16053# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16054
16055# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16056#endif
16057 do i = 1, strxe - strxb + 1
16058 ! Elastic contribution to energy if G large enough
16059 if ((g_l > verysmall) .and. (g_r > verysmall)) then
16060 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
16061 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
16062 ! Additional terms in 2D and 3D
16063 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
16064 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
16065 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
16066 end if
16067 end if
16068 end do
16069 end if
16070
16071 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
16072 if (hyperelasticity) then
16073
16074# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16075#if defined(MFC_OpenACC)
16076# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16077!$acc loop seq
16078# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16079#elif defined(MFC_OpenMP)
16080# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16081
16082# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16083#endif
16084 do i = 1, num_dims
16085 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, xibeg - 1 + i)
16086 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
16087 end do
16088 g_l = 0._wp
16089 g_r = 0._wp
16090
16091# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16092#if defined(MFC_OpenACC)
16093# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16094!$acc loop seq
16095# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16096#elif defined(MFC_OpenMP)
16097# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16098
16099# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16100#endif
16101 do i = 1, num_fluids
16102 ! Mixture left and right shear modulus
16103 g_l = g_l + alpha_l(i)*gs_rs(i)
16104 g_r = g_r + alpha_r(i)*gs_rs(i)
16105 end do
16106 ! Elastic contribution to energy if G large enough
16107 if (g_l > verysmall .and. g_r > verysmall) then
16108 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, xiend + 1)
16109 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, xiend + 1)
16110 end if
16111
16112# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16113#if defined(MFC_OpenACC)
16114# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16115!$acc loop seq
16116# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16117#elif defined(MFC_OpenMP)
16118# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16119
16120# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16121#endif
16122 do i = 1, b_size - 1
16123 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
16124 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
16125 end do
16126 end if
16127
16128 h_l = (e_l + pres_l)/rho_l
16129 h_r = (e_r + pres_r)/rho_r
16130
16131
16132# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16133 if (avg_state == 1) then
16134# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16135
16136# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16137 rho_avg = sqrt(rho_l*rho_r)
16138# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16139
16140# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16141 vel_avg_rms = 0._wp
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
16146# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16147#if defined(MFC_OpenACC)
16148# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16149!$acc loop seq
16150# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16151#elif defined(MFC_OpenMP)
16152# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16153
16154# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16155#endif
16156# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16157 do i = 1, num_vels
16158# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16159 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
16160# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16161 (sqrt(rho_l) + sqrt(rho_r))**2._wp
16162# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16163 end do
16164# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16165
16166# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16167 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
16168# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16169 (sqrt(rho_l) + sqrt(rho_r))
16170# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16171
16172# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16173 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
16174# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16175 (sqrt(rho_l) + sqrt(rho_r))
16176# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16177
16178# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16179 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
16180# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16181 (sqrt(rho_l) + sqrt(rho_r))**2._wp
16182# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16183
16184# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16185 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
16186# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16187 (sqrt(rho_l) + sqrt(rho_r))
16188# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16189
16190# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16191 if (chemistry) then
16192# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16193 eps = 0.001_wp
16194# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16195 call get_species_enthalpies_rt(t_l, h_il)
16196# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16197 call get_species_enthalpies_rt(t_r, h_ir)
16198# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16199 h_il = h_il*gas_constant/molecular_weights*t_l
16200# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16201 h_ir = h_ir*gas_constant/molecular_weights*t_r
16202# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16203 call get_species_specific_heats_r(t_l, cp_il)
16204# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16205 call get_species_specific_heats_r(t_r, cp_ir)
16206# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16207
16208# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16209 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
16210# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16211 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
16212# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16213 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
16214# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16215 if (abs(t_l - t_r) < eps) then
16216# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16217 ! Case when T_L and T_R are very close
16218# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16219 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
16220# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16221 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
16222# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16223 else
16224# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16225 ! Normal calculation when T_L and T_R are sufficiently different
16226# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16227 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
16228# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16229 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
16230# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16231 end if
16232# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16233 gamma_avg = cp_avg/cv_avg
16234# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16235
16236# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16237 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
16238# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16239 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
16240# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16241
16242# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16243 end if
16244# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16245
16246# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16247 end if
16248# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16249
16250# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16251 if (avg_state == 2) then
16252# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16253 rho_avg = 5.e-1_wp*(rho_l + rho_r)
16254# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16255 vel_avg_rms = 0._wp
16256# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16257
16258# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16259#if defined(MFC_OpenACC)
16260# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16261!$acc loop seq
16262# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16263#elif defined(MFC_OpenMP)
16264# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16265
16266# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16267#endif
16268# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16269 do i = 1, num_vels
16270# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16271 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
16272# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16273 end do
16274# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16275
16276# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16277 h_avg = 5.e-1_wp*(h_l + h_r)
16278# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16279 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
16280# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16281 qv_avg = 5.e-1_wp*(qv_l + qv_r)
16282# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16283
16284# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16285 end if
16286# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16287
16288
16289 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
16290 vel_l_rms, 0._wp, c_l, qv_l)
16291
16292 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
16293 vel_r_rms, 0._wp, c_r, qv_r)
16294
16295 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
16296 ! variables are placeholders to call the subroutine.
16297 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
16298 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
16299
16300 if (viscous) then
16301 if (chemistry) then
16302 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
16303 end if
16304
16305# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16306#if defined(MFC_OpenACC)
16307# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16308!$acc loop seq
16309# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16310#elif defined(MFC_OpenMP)
16311# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16312
16313# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16314#endif
16315 do i = 1, 2
16316 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
16317 end do
16318 end if
16319
16320 ! Low Mach correction
16321 if (low_mach == 2) then
16322
16323# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16324 if (riemann_solver == 1 .or. riemann_solver == 5) then
16325# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16326
16327# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16328 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16329# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16330 pcorr = 0._wp
16331# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16332
16333# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16334 if (low_mach == 1) then
16335# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16336 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
16337# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16338 end if
16339# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16340
16341# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16342 else if (riemann_solver == 2) then
16343# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16344 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16345# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16346 pcorr = 0._wp
16347# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16348
16349# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16350 if (low_mach == 1) then
16351# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16352 pcorr = rho_l*rho_r* &
16353# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16354 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
16355# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16356 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
16357# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16358 (zcoef - 1._wp)
16359# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16360 else if (low_mach == 2) then
16361# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16362 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))))
16363# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16364 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))))
16365# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16366 vel_l(dir_idx(1)) = vel_l_tmp
16367# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16368 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
16373# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16374
16375 end if
16376
16377 if (wave_speeds == 1) then
16378 if (elasticity) then
16379 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
16380 (((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 + &
16381 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
16382 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
16383 (((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 + &
16384 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
16385 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
16386 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
16387 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
16388 rho_r*(s_r - vel_r(dir_idx(1))))
16389 else
16390 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
16391 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
16392 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
16393 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
16394 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
16395
16396 end if
16397 elseif (wave_speeds == 2) then
16398 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
16399 (vel_l(dir_idx(1)) - &
16400 vel_r(dir_idx(1))))
16401
16402 pres_sr = pres_sl
16403
16404 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
16405 (pres_sl/pres_l - 1._wp)*pres_l/ &
16406 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
16407 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
16408 (pres_sr/pres_r - 1._wp)*pres_r/ &
16409 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
16410
16411 s_l = vel_l(dir_idx(1)) - c_l*ms_l
16412 s_r = vel_r(dir_idx(1)) + c_r*ms_r
16413
16414 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
16415 (pres_l - pres_r)/ &
16416 (rho_avg*c_avg))
16417 end if
16418
16419 ! follows Einfeldt et al.
16420 ! s_M/P = min/max(0.,s_L/R)
16421 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
16422
16423 ! goes with q_star_L/R = xi_L/R * (variable)
16424 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
16425 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
16426 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
16427
16428 ! goes with numerical velocity in x/y/z directions
16429 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
16430 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
16431 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
16432
16433 ! Low Mach correction
16434 if (low_mach == 1) then
16435
16436# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16437 if (riemann_solver == 1 .or. riemann_solver == 5) then
16438# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16439
16440# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16441 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16442# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16443 pcorr = 0._wp
16444# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16445
16446# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16447 if (low_mach == 1) then
16448# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16449 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
16450# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16451 end if
16452# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16453
16454# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16455 else if (riemann_solver == 2) then
16456# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16457 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16458# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16459 pcorr = 0._wp
16460# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16461
16462# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16463 if (low_mach == 1) then
16464# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16465 pcorr = rho_l*rho_r* &
16466# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16467 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
16468# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16469 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
16470# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16471 (zcoef - 1._wp)
16472# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16473 else if (low_mach == 2) then
16474# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16475 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))))
16476# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16477 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))))
16478# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16479 vel_l(dir_idx(1)) = vel_l_tmp
16480# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16481 vel_r(dir_idx(1)) = vel_r_tmp
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 end if
16486# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16487
16488 else
16489 pcorr = 0._wp
16490 end if
16491
16492 ! COMPUTING THE HLLC FLUXES
16493 ! MASS FLUX.
16494
16495# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16496#if defined(MFC_OpenACC)
16497# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16498!$acc loop seq
16499# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16500#elif defined(MFC_OpenMP)
16501# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16502
16503# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16504#endif
16505 do i = 1, contxe
16506 flux_rsz_vf(j, k, l, i) = &
16507 xi_m*ql_prim_rsz_vf(j, k, l, i) &
16508 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16509 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
16510 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16511 end do
16512
16513 ! MOMENTUM FLUX.
16514 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
16515
16516# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16517#if defined(MFC_OpenACC)
16518# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16519!$acc loop seq
16520# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16521#elif defined(MFC_OpenMP)
16522# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16523
16524# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16525#endif
16526 do i = 1, num_dims
16527 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
16528 xi_m*(rho_l*(vel_l(dir_idx(1))* &
16529 vel_l(dir_idx(i)) + &
16530 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
16531 (1._wp - dir_flg(dir_idx(i)))* &
16532 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
16533 dir_flg(dir_idx(i))*(pres_l)) &
16534 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
16535 vel_r(dir_idx(i)) + &
16536 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
16537 (1._wp - dir_flg(dir_idx(i)))* &
16538 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
16539 dir_flg(dir_idx(i))*(pres_r)) &
16540 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
16541 end do
16542
16543 ! ENERGY FLUX.
16544 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
16545 flux_rsz_vf(j, k, l, e_idx) = &
16546 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
16547 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
16548 (rho_l*s_s + pres_l/ &
16549 (s_l - vel_l(dir_idx(1))))) - e_l)) &
16550 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
16551 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
16552 (rho_r*s_s + pres_r/ &
16553 (s_r - vel_r(dir_idx(1))))) - e_r)) &
16554 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
16555
16556 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
16557 if (elasticity) then
16558 flux_ene_e = 0._wp
16559
16560# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16561#if defined(MFC_OpenACC)
16562# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16563!$acc loop seq
16564# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16565#elif defined(MFC_OpenMP)
16566# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16567
16568# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16569#endif
16570 do i = 1, num_dims
16571 ! MOMENTUM ELASTIC FLUX.
16572 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
16573 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) &
16574 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
16575 ! ENERGY ELASTIC FLUX.
16576 flux_ene_e = flux_ene_e - &
16577 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
16578 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
16579 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
16580 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
16581 end do
16582 flux_rsz_vf(j, k, l, e_idx) = flux_rsz_vf(j, k, l, e_idx) + flux_ene_e
16583 end if
16584
16585 ! HYPOELASTIC STRESS EVOLUTION FLUX.
16586 if (hypoelasticity) then
16587
16588# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16589#if defined(MFC_OpenACC)
16590# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16591!$acc loop seq
16592# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16593#elif defined(MFC_OpenMP)
16594# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16595
16596# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16597#endif
16598 do i = 1, strxe - strxb + 1
16599 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
16600 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)) + &
16601 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))
16602 end do
16603 end if
16604
16605 ! VOLUME FRACTION FLUX.
16606
16607# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16608#if defined(MFC_OpenACC)
16609# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16610!$acc loop seq
16611# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16612#elif defined(MFC_OpenMP)
16613# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16614
16615# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16616#endif
16617 do i = advxb, advxe
16618 flux_rsz_vf(j, k, l, i) = &
16619 xi_m*ql_prim_rsz_vf(j, k, l, i) &
16620 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16621 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
16622 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16623 end do
16624
16625 ! VOLUME FRACTION SOURCE FLUX.
16626
16627# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16628#if defined(MFC_OpenACC)
16629# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16630!$acc loop seq
16631# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16632#elif defined(MFC_OpenMP)
16633# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16634
16635# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16636#endif
16637 do i = 1, num_dims
16638 vel_src_rsz_vf(j, k, l, dir_idx(i)) = &
16639 xi_m*(vel_l(dir_idx(i)) + &
16640 dir_flg(dir_idx(i))* &
16641 s_m*(xi_l - 1._wp)) &
16642 + xi_p*(vel_r(dir_idx(i)) + &
16643 dir_flg(dir_idx(i))* &
16644 s_p*(xi_r - 1._wp))
16645 end do
16646
16647 ! COLOR FUNCTION FLUX
16648 if (surface_tension) then
16649 flux_rsz_vf(j, k, l, c_idx) = &
16650 xi_m*ql_prim_rsz_vf(j, k, l, c_idx) &
16651 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16652 + xi_p*qr_prim_rsz_vf(j + 1, k, l, c_idx) &
16653 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16654 end if
16655
16656 ! REFERENCE MAP FLUX.
16657 if (hyperelasticity) then
16658
16659# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16660#if defined(MFC_OpenACC)
16661# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16662!$acc loop seq
16663# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16664#elif defined(MFC_OpenMP)
16665# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16666
16667# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16668#endif
16669 do i = 1, num_dims
16670 flux_rsz_vf(j, k, l, xibeg - 1 + i) = &
16671 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
16672 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
16673 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
16674 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
16675 end do
16676 end if
16677
16678 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
16679
16680 if (chemistry) then
16681
16682# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16683#if defined(MFC_OpenACC)
16684# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16685!$acc loop seq
16686# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16687#elif defined(MFC_OpenMP)
16688# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16689
16690# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16691#endif
16692 do i = chemxb, chemxe
16693 y_l = ql_prim_rsz_vf(j, k, l, i)
16694 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
16695
16696 flux_rsz_vf(j, k, l, i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16697 + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16698 flux_src_rsz_vf(j, k, l, i) = 0.0_wp
16699 end do
16700 end if
16701
16702 ! Geometrical source flux for cylindrical coordinates
16703# 3631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16704# 3632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16705 if (grid_geometry == 3) then
16706
16707# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16708#if defined(MFC_OpenACC)
16709# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16710!$acc loop seq
16711# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16712#elif defined(MFC_OpenMP)
16713# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16714
16715# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16716#endif
16717 do i = 1, sys_size
16718 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
16719 end do
16720
16721 flux_gsrc_rsz_vf(j, k, l, momxb + 1) = &
16722 -xi_m*(rho_l*(vel_l(dir_idx(1))* &
16723 vel_l(dir_idx(1)) + &
16724 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
16725 (1._wp - dir_flg(dir_idx(1)))* &
16726 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
16727 - xi_p*(rho_r*(vel_r(dir_idx(1))* &
16728 vel_r(dir_idx(1)) + &
16729 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
16730 (1._wp - dir_flg(dir_idx(1)))* &
16731 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
16732 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
16733
16734 end if
16735# 3653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16736
16737 end do
16738 end do
16739 end do
16740
16741# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16742
16743# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16744#if defined(MFC_OpenACC)
16745# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16746!$acc end parallel loop
16747# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16748#elif defined(MFC_OpenMP)
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
16753# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16754!$omp end target teams loop
16755# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16756#endif
16757# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16758
16759 end if
16760 end if
16761# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16762 ! Computing HLLC flux and source flux for Euler system of equations
16763
16764 if (viscous .or. dummy) then
16765 if (weno_re_flux) then
16766 call s_compute_viscous_source_flux( &
16767 ql_prim_vf(momxb:momxe), &
16768 dql_prim_dx_vf(momxb:momxe), &
16769 dql_prim_dy_vf(momxb:momxe), &
16770 dql_prim_dz_vf(momxb:momxe), &
16771 qr_prim_vf(momxb:momxe), &
16772 dqr_prim_dx_vf(momxb:momxe), &
16773 dqr_prim_dy_vf(momxb:momxe), &
16774 dqr_prim_dz_vf(momxb:momxe), &
16775 flux_src_vf, norm_dir, ix, iy, iz)
16776 else
16777 call s_compute_viscous_source_flux( &
16778 q_prim_vf(momxb:momxe), &
16779 dql_prim_dx_vf(momxb:momxe), &
16780 dql_prim_dy_vf(momxb:momxe), &
16781 dql_prim_dz_vf(momxb:momxe), &
16782 q_prim_vf(momxb:momxe), &
16783 dqr_prim_dx_vf(momxb:momxe), &
16784 dqr_prim_dy_vf(momxb:momxe), &
16785 dqr_prim_dz_vf(momxb:momxe), &
16786 flux_src_vf, norm_dir, ix, iy, iz)
16787 end if
16788 end if
16789
16790 if (surface_tension) then
16791 call s_compute_capillary_source_flux( &
16792 vel_src_rsx_vf, &
16793 vel_src_rsy_vf, &
16794 vel_src_rsz_vf, &
16795 flux_src_vf, &
16796 norm_dir, isx, isy, isz)
16797 end if
16798
16799 call s_finalize_riemann_solver(flux_vf, flux_src_vf, &
16800 flux_gsrc_vf, &
16801 norm_dir)
16802
16803 end subroutine s_hllc_riemann_solver
16804
16805 !> HLLD Riemann solver resolves 5 of the 7 waves of MHD equations:
16806 !! 1 entropy wave, 2 Alfvén waves, 2 fast magnetosonic waves.
16807 subroutine s_hlld_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, &
16808 dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
16809 qL_prim_vf, &
16810 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, &
16811 dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, &
16812 qR_prim_vf, &
16813 q_prim_vf, &
16814 flux_vf, flux_src_vf, flux_gsrc_vf, &
16815 norm_dir, ix, iy, iz)
16816
16817 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, &
16818 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf
16819
16820 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
16821 dql_prim_dy_vf, dqr_prim_dy_vf, &
16822 dql_prim_dz_vf, dqr_prim_dz_vf
16823
16824 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
16825
16826 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
16827 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
16828
16829 integer, intent(in) :: norm_dir
16830 type(int_bounds_info), intent(in) :: ix, iy, iz
16831
16832 ! Local variables:
16833# 3735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16834 real(wp), dimension(num_fluids) :: alpha_l, alpha_r, alpha_rho_l, alpha_rho_r
16835# 3737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16836 type(riemann_states_vec3) :: vel
16837 type(riemann_states) :: rho, pres, e, h_no_mag
16838 type(riemann_states) :: gamma, pi_inf, qv
16839 type(riemann_states) :: vel_rms
16840
16841 type(riemann_states_vec3) :: b
16842 type(riemann_states) :: c, c_fast, pres_mag
16843
16844 ! HLLD speeds and intermediate state variables:
16845 real(wp) :: s_l, s_r, s_m, s_starl, s_starr
16846 real(wp) :: ptot_l, ptot_r, p_star, rhol_star, rhor_star, e_starl, e_starr
16847
16848 real(wp), dimension(7) :: u_l, u_r, u_starl, u_starr, u_doublel, u_doubler
16849 real(wp), dimension(7) :: f_l, f_r, f_starl, f_starr, f_hlld
16850
16851 ! Indices for U and F: (rho, rho*vel(1), rho*vel(2), rho*vel(3), By, Bz, E)
16852 ! Note: vel and B are permutated, so vel(1) is the normal velocity, and x is the normal direction
16853 ! Note: Bx is omitted as the magnetic flux is always zero in the normal direction
16854
16855 real(wp) :: sqrt_rhol_star, sqrt_rhor_star, denom_ds, sign_bx
16856 real(wp) :: vl_star, vr_star, wl_star, wr_star
16857 real(wp) :: v_double, w_double, by_double, bz_double, e_doublel, e_doubler, e_double
16858
16859 integer :: i, j, k, l
16860
16861 call s_populate_riemann_states_variables_buffers( &
16862 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
16863 dql_prim_dy_vf, dql_prim_dz_vf, &
16864 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
16865 dqr_prim_dy_vf, dqr_prim_dz_vf, &
16866 norm_dir, ix, iy, iz)
16867
16868 call s_initialize_riemann_solver( &
16869 flux_src_vf, norm_dir)
16870
16871# 3773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16872 if (norm_dir == 1) then
16873
16874# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16875
16876# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16877#if defined(MFC_OpenACC)
16878# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16879!$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)
16880# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16881#elif defined(MFC_OpenMP)
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
16888# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16889!$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)
16890# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16891#endif
16892# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16893
16894 do l = is3%beg, is3%end
16895 do k = is2%beg, is2%end
16896 do j = is1%beg, is1%end
16897
16898 ! (1) Extract the left/right primitive states
16899 do i = 1, contxe
16900 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
16901 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
16902 end do
16903
16904 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
16905 do i = 1, num_vels
16906 vel%L(i) = ql_prim_rsx_vf(j, k, l, contxe + dir_idx(i))
16907 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + dir_idx(i))
16908 end do
16909
16910 vel_rms%L = sum(vel%L**2._wp)
16911 vel_rms%R = sum(vel%R**2._wp)
16912
16913 do i = 1, num_fluids
16914 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
16915 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
16916 end do
16917
16918 pres%L = ql_prim_rsx_vf(j, k, l, e_idx)
16919 pres%R = qr_prim_rsx_vf(j + 1, k, l, e_idx)
16920
16921 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
16922 if (mhd) then
16923 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
16924 b%L = [bx0, ql_prim_rsx_vf(j, k, l, b_idx%beg), ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)]
16925 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)]
16926 else ! 2D/3D: Bx, By, Bz as variables
16927 b%L = [ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), &
16928 ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(2) - 1), &
16929 ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(3) - 1)]
16930 b%R = [qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
16931 qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
16932 qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
16933 end if
16934 end if
16935
16936 ! Sum properties of all fluid components
16937 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
16938 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
16939
16940# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16941#if defined(MFC_OpenACC)
16942# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16943!$acc loop seq
16944# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16945#elif defined(MFC_OpenMP)
16946# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16947
16948# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16949#endif
16950 do i = 1, num_fluids
16951 rho%L = rho%L + alpha_rho_l(i)
16952 gamma%L = gamma%L + alpha_l(i)*gammas(i)
16953 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
16954 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
16955
16956 rho%R = rho%R + alpha_rho_r(i)
16957 gamma%R = gamma%R + alpha_r(i)*gammas(i)
16958 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
16959 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
16960 end do
16961
16962 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
16963 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
16964 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
16965 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
16966 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
16967 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)
16968
16969 ! (2) Compute fast wave speeds
16970 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)
16971 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)
16972 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
16973 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
16974
16975 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
16976 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
16977 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
16978
16979 ptot_l = pres%L + pres_mag%L
16980 ptot_r = pres%R + pres_mag%R
16981
16982 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - &
16983 (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/ &
16984 ((s_r - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
16985
16986 ! (4) Compute star state variables
16987 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
16988 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
16989 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
16990 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
16991 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
16992
16993 ! (5) Compute left/right state vectors and fluxes
16994 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
16995 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
16996 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
16997 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
16998
16999 ! Compute the left/right fluxes
17000 f_l(1) = u_l(2)
17001 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
17002 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
17003 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
17004 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))
17005
17006 f_r(1) = u_r(2)
17007 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
17008 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
17009 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
17010 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))
17011 ! Compute the star flux using HLL relation
17012 f_starl = f_l + s_l*(u_starl - u_l)
17013 f_starr = f_r + s_r*(u_starr - u_r)
17014 ! Compute the rotational (Alfvén) speeds
17015 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
17016 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
17017 ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17018 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
17019 vl_star = vel%L(2); wl_star = vel%L(3)
17020 vr_star = vel%R(2); wr_star = vel%R(3)
17021
17022 ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17023 denom_ds = sqrt_rhol_star + sqrt_rhor_star
17024 sign_bx = sign(1._wp, b%L(1))
17025 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
17026 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
17027 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
17028 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
17029
17030 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
17031 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
17032 e_double = 0.5_wp*(e_doublel + e_doubler)
17033
17034 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, e_double]
17035 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, e_double]
17036
17037 ! (11) Choose HLLD flux based on wave-speed regions
17038 if (0.0_wp <= s_l) then
17039 f_hlld = f_l
17040 else if (0.0_wp <= s_starl) then
17041 f_hlld = f_l + s_l*(u_starl - u_l)
17042 else if (0.0_wp <= s_m) then
17043 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
17044 else if (0.0_wp <= s_starr) then
17045 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
17046 else if (0.0_wp <= s_r) then
17047 f_hlld = f_r + s_r*(u_starr - u_r)
17048 else
17049 f_hlld = f_r
17050 end if
17051
17052 ! (12) Reorder and write temporary variables to the flux array
17053 ! Mass
17054 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
17055 ! Momentum
17056 flux_rsx_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
17057 flux_rsx_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
17058 flux_rsx_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
17059 ! Magnetic field
17060 if (n == 0) then
17061 flux_rsx_vf(j, k, l, b_idx%beg) = f_hlld(5)
17062 flux_rsx_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
17063 else
17064 flux_rsx_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
17065 flux_rsx_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
17066 end if
17067 ! Energy
17068 flux_rsx_vf(j, k, l, e_idx) = f_hlld(7)
17069 ! Partial fraction
17070
17071# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17072#if defined(MFC_OpenACC)
17073# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17074!$acc loop seq
17075# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17076#elif defined(MFC_OpenMP)
17077# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17078
17079# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17080#endif
17081 do i = advxb, advxe
17082 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
17083 end do
17084
17085 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
17086 end do
17087 end do
17088 end do
17089
17090# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17091
17092# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17093#if defined(MFC_OpenACC)
17094# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17095!$acc end parallel loop
17096# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17097#elif defined(MFC_OpenMP)
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
17102# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17103!$omp end target teams loop
17104# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17105#endif
17106# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17107
17108 end if
17109# 3773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17110 if (norm_dir == 2) then
17111
17112# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17113
17114# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17115#if defined(MFC_OpenACC)
17116# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17117!$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)
17118# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17119#elif defined(MFC_OpenMP)
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
17126# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17127!$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)
17128# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17129#endif
17130# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17131
17132 do l = is3%beg, is3%end
17133 do k = is2%beg, is2%end
17134 do j = is1%beg, is1%end
17135
17136 ! (1) Extract the left/right primitive states
17137 do i = 1, contxe
17138 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
17139 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
17140 end do
17141
17142 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
17143 do i = 1, num_vels
17144 vel%L(i) = ql_prim_rsy_vf(j, k, l, contxe + dir_idx(i))
17145 vel%R(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + dir_idx(i))
17146 end do
17147
17148 vel_rms%L = sum(vel%L**2._wp)
17149 vel_rms%R = sum(vel%R**2._wp)
17150
17151 do i = 1, num_fluids
17152 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
17153 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
17154 end do
17155
17156 pres%L = ql_prim_rsy_vf(j, k, l, e_idx)
17157 pres%R = qr_prim_rsy_vf(j + 1, k, l, e_idx)
17158
17159 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
17160 if (mhd) then
17161 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
17162 b%L = [bx0, ql_prim_rsy_vf(j, k, l, b_idx%beg), ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)]
17163 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)]
17164 else ! 2D/3D: Bx, By, Bz as variables
17165 b%L = [ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), &
17166 ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(2) - 1), &
17167 ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(3) - 1)]
17168 b%R = [qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
17169 qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
17170 qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
17171 end if
17172 end if
17173
17174 ! Sum properties of all fluid components
17175 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
17176 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
17177
17178# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17179#if defined(MFC_OpenACC)
17180# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17181!$acc loop seq
17182# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17183#elif defined(MFC_OpenMP)
17184# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17185
17186# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17187#endif
17188 do i = 1, num_fluids
17189 rho%L = rho%L + alpha_rho_l(i)
17190 gamma%L = gamma%L + alpha_l(i)*gammas(i)
17191 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
17192 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
17193
17194 rho%R = rho%R + alpha_rho_r(i)
17195 gamma%R = gamma%R + alpha_r(i)*gammas(i)
17196 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
17197 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
17198 end do
17199
17200 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
17201 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
17202 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
17203 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
17204 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
17205 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)
17206
17207 ! (2) Compute fast wave speeds
17208 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)
17209 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)
17210 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
17211 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
17212
17213 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
17214 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
17215 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
17216
17217 ptot_l = pres%L + pres_mag%L
17218 ptot_r = pres%R + pres_mag%R
17219
17220 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - &
17221 (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/ &
17222 ((s_r - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
17223
17224 ! (4) Compute star state variables
17225 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
17226 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
17227 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
17228 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
17229 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
17230
17231 ! (5) Compute left/right state vectors and fluxes
17232 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
17233 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
17234 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
17235 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
17236
17237 ! Compute the left/right fluxes
17238 f_l(1) = u_l(2)
17239 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
17240 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
17241 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
17242 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))
17243
17244 f_r(1) = u_r(2)
17245 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
17246 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
17247 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
17248 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))
17249 ! Compute the star flux using HLL relation
17250 f_starl = f_l + s_l*(u_starl - u_l)
17251 f_starr = f_r + s_r*(u_starr - u_r)
17252 ! Compute the rotational (Alfvén) speeds
17253 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
17254 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
17255 ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17256 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
17257 vl_star = vel%L(2); wl_star = vel%L(3)
17258 vr_star = vel%R(2); wr_star = vel%R(3)
17259
17260 ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17261 denom_ds = sqrt_rhol_star + sqrt_rhor_star
17262 sign_bx = sign(1._wp, b%L(1))
17263 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
17264 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
17265 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
17266 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
17267
17268 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
17269 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
17270 e_double = 0.5_wp*(e_doublel + e_doubler)
17271
17272 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, e_double]
17273 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, e_double]
17274
17275 ! (11) Choose HLLD flux based on wave-speed regions
17276 if (0.0_wp <= s_l) then
17277 f_hlld = f_l
17278 else if (0.0_wp <= s_starl) then
17279 f_hlld = f_l + s_l*(u_starl - u_l)
17280 else if (0.0_wp <= s_m) then
17281 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
17282 else if (0.0_wp <= s_starr) then
17283 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
17284 else if (0.0_wp <= s_r) then
17285 f_hlld = f_r + s_r*(u_starr - u_r)
17286 else
17287 f_hlld = f_r
17288 end if
17289
17290 ! (12) Reorder and write temporary variables to the flux array
17291 ! Mass
17292 flux_rsy_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
17293 ! Momentum
17294 flux_rsy_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
17295 flux_rsy_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
17296 flux_rsy_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
17297 ! Magnetic field
17298 if (n == 0) then
17299 flux_rsy_vf(j, k, l, b_idx%beg) = f_hlld(5)
17300 flux_rsy_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
17301 else
17302 flux_rsy_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
17303 flux_rsy_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
17304 end if
17305 ! Energy
17306 flux_rsy_vf(j, k, l, e_idx) = f_hlld(7)
17307 ! Partial fraction
17308
17309# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17310#if defined(MFC_OpenACC)
17311# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17312!$acc loop seq
17313# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17314#elif defined(MFC_OpenMP)
17315# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17316
17317# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17318#endif
17319 do i = advxb, advxe
17320 flux_rsy_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
17321 end do
17322
17323 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
17324 end do
17325 end do
17326 end do
17327
17328# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17329
17330# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17331#if defined(MFC_OpenACC)
17332# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17333!$acc end parallel loop
17334# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17335#elif defined(MFC_OpenMP)
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
17340# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17341!$omp end target teams loop
17342# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17343#endif
17344# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17345
17346 end if
17347# 3773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17348 if (norm_dir == 3) then
17349
17350# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17351
17352# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17353#if defined(MFC_OpenACC)
17354# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17355!$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)
17356# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17357#elif defined(MFC_OpenMP)
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
17364# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17365!$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)
17366# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17367#endif
17368# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17369
17370 do l = is3%beg, is3%end
17371 do k = is2%beg, is2%end
17372 do j = is1%beg, is1%end
17373
17374 ! (1) Extract the left/right primitive states
17375 do i = 1, contxe
17376 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
17377 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
17378 end do
17379
17380 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
17381 do i = 1, num_vels
17382 vel%L(i) = ql_prim_rsz_vf(j, k, l, contxe + dir_idx(i))
17383 vel%R(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + dir_idx(i))
17384 end do
17385
17386 vel_rms%L = sum(vel%L**2._wp)
17387 vel_rms%R = sum(vel%R**2._wp)
17388
17389 do i = 1, num_fluids
17390 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
17391 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
17392 end do
17393
17394 pres%L = ql_prim_rsz_vf(j, k, l, e_idx)
17395 pres%R = qr_prim_rsz_vf(j + 1, k, l, e_idx)
17396
17397 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
17398 if (mhd) then
17399 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
17400 b%L = [bx0, ql_prim_rsz_vf(j, k, l, b_idx%beg), ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)]
17401 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)]
17402 else ! 2D/3D: Bx, By, Bz as variables
17403 b%L = [ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), &
17404 ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(2) - 1), &
17405 ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(3) - 1)]
17406 b%R = [qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
17407 qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
17408 qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
17409 end if
17410 end if
17411
17412 ! Sum properties of all fluid components
17413 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
17414 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
17415
17416# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17417#if defined(MFC_OpenACC)
17418# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17419!$acc loop seq
17420# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17421#elif defined(MFC_OpenMP)
17422# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17423
17424# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17425#endif
17426 do i = 1, num_fluids
17427 rho%L = rho%L + alpha_rho_l(i)
17428 gamma%L = gamma%L + alpha_l(i)*gammas(i)
17429 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
17430 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
17431
17432 rho%R = rho%R + alpha_rho_r(i)
17433 gamma%R = gamma%R + alpha_r(i)*gammas(i)
17434 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
17435 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
17436 end do
17437
17438 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
17439 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
17440 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
17441 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
17442 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
17443 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)
17444
17445 ! (2) Compute fast wave speeds
17446 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)
17447 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)
17448 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
17449 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
17450
17451 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
17452 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
17453 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
17454
17455 ptot_l = pres%L + pres_mag%L
17456 ptot_r = pres%R + pres_mag%R
17457
17458 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - &
17459 (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/ &
17460 ((s_r - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
17461
17462 ! (4) Compute star state variables
17463 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
17464 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
17465 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
17466 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
17467 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
17468
17469 ! (5) Compute left/right state vectors and fluxes
17470 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
17471 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
17472 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
17473 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
17474
17475 ! Compute the left/right fluxes
17476 f_l(1) = u_l(2)
17477 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
17478 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
17479 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
17480 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))
17481
17482 f_r(1) = u_r(2)
17483 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
17484 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
17485 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
17486 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))
17487 ! Compute the star flux using HLL relation
17488 f_starl = f_l + s_l*(u_starl - u_l)
17489 f_starr = f_r + s_r*(u_starr - u_r)
17490 ! Compute the rotational (Alfvén) speeds
17491 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
17492 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
17493 ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17494 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
17495 vl_star = vel%L(2); wl_star = vel%L(3)
17496 vr_star = vel%R(2); wr_star = vel%R(3)
17497
17498 ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17499 denom_ds = sqrt_rhol_star + sqrt_rhor_star
17500 sign_bx = sign(1._wp, b%L(1))
17501 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
17502 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
17503 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
17504 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
17505
17506 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
17507 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
17508 e_double = 0.5_wp*(e_doublel + e_doubler)
17509
17510 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, e_double]
17511 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, e_double]
17512
17513 ! (11) Choose HLLD flux based on wave-speed regions
17514 if (0.0_wp <= s_l) then
17515 f_hlld = f_l
17516 else if (0.0_wp <= s_starl) then
17517 f_hlld = f_l + s_l*(u_starl - u_l)
17518 else if (0.0_wp <= s_m) then
17519 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
17520 else if (0.0_wp <= s_starr) then
17521 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
17522 else if (0.0_wp <= s_r) then
17523 f_hlld = f_r + s_r*(u_starr - u_r)
17524 else
17525 f_hlld = f_r
17526 end if
17527
17528 ! (12) Reorder and write temporary variables to the flux array
17529 ! Mass
17530 flux_rsz_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
17531 ! Momentum
17532 flux_rsz_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
17533 flux_rsz_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
17534 flux_rsz_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
17535 ! Magnetic field
17536 if (n == 0) then
17537 flux_rsz_vf(j, k, l, b_idx%beg) = f_hlld(5)
17538 flux_rsz_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
17539 else
17540 flux_rsz_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
17541 flux_rsz_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
17542 end if
17543 ! Energy
17544 flux_rsz_vf(j, k, l, e_idx) = f_hlld(7)
17545 ! Partial fraction
17546
17547# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17548#if defined(MFC_OpenACC)
17549# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17550!$acc loop seq
17551# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17552#elif defined(MFC_OpenMP)
17553# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17554
17555# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17556#endif
17557 do i = advxb, advxe
17558 flux_rsz_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
17559 end do
17560
17561 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
17562 end do
17563 end do
17564 end do
17565
17566# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17567
17568# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17569#if defined(MFC_OpenACC)
17570# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17571!$acc end parallel loop
17572# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17573#elif defined(MFC_OpenMP)
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
17578# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17579!$omp end target teams loop
17580# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17581#endif
17582# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17583
17584 end if
17585# 3953 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17586
17587 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, &
17588 norm_dir)
17589 end subroutine s_hlld_riemann_solver
17590
17591 !> The computation of parameters, the allocation of memory,
17592 !! the association of pointers and/or the execution of any
17593 !! other procedures that are necessary to setup the module.
17594 impure subroutine s_initialize_riemann_solvers_module
17595
17596 ! Allocating the variables that will be utilized to formulate the
17597 ! left, right, and average states of the Riemann problem, as well
17598 ! the Riemann problem solution
17599 integer :: i, j
17600
17601#ifdef MFC_DEBUG
17602# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17603 block
17604# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17605 use iso_fortran_env, only: output_unit
17606# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17607
17608# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17609 print *, 'm_riemann_solvers.fpp:3968: ', '@:ALLOCATE(Gs_rs(1:num_fluids))'
17610# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17611
17612# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17613 call flush (output_unit)
17614# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17615 end block
17616# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17617#endif
17618# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17619 allocate (gs_rs(1:num_fluids))
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
17624# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17625#if defined(MFC_OpenACC)
17626# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17627!$acc enter data create(Gs_rs)
17628# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17629#elif defined(MFC_OpenMP)
17630# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17631!$omp target enter data map(always,alloc:Gs_rs)
17632# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17633#endif
17634
17635 do i = 1, num_fluids
17636 gs_rs(i) = fluid_pp(i)%G
17637 end do
17638
17639# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17640#if defined(MFC_OpenACC)
17641# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17642!$acc update device(Gs_rs)
17643# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17644#elif defined(MFC_OpenMP)
17645# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17646!$omp target update to(Gs_rs)
17647# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17648#endif
17649
17650 if (viscous) then
17651#ifdef MFC_DEBUG
17652# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17653 block
17654# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17655 use iso_fortran_env, only: output_unit
17656# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17657
17658# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17659 print *, 'm_riemann_solvers.fpp:3976: ', '@:ALLOCATE(Res_gs(1:2, 1:Re_size_max))'
17660# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17661
17662# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17663 call flush (output_unit)
17664# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17665 end block
17666# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17667#endif
17668# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17669 allocate (res_gs(1:2, 1:re_size_max))
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
17674# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17675#if defined(MFC_OpenACC)
17676# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17677!$acc enter data create(Res_gs)
17678# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17679#elif defined(MFC_OpenMP)
17680# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17681!$omp target enter data map(always,alloc:Res_gs)
17682# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17683#endif
17684 end if
17685
17686 if (viscous) then
17687 do i = 1, 2
17688 do j = 1, re_size(i)
17689 res_gs(i, j) = fluid_pp(re_idx(i, j))%Re(i)
17690 end do
17691 end do
17692
17693# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17694#if defined(MFC_OpenACC)
17695# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17696!$acc update device(Res_gs, Re_idx, Re_size)
17697# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17698#elif defined(MFC_OpenMP)
17699# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17700!$omp target update to(Res_gs, Re_idx, Re_size)
17701# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17702#endif
17703 end if
17704
17705
17706# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17707#if defined(MFC_OpenACC)
17708# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17709!$acc enter data copyin(is1, is2, is3, isx, isy, isz)
17710# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17711#elif defined(MFC_OpenMP)
17712# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17713!$omp target enter data map(to:is1, is2, is3, isx, isy, isz)
17714# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17715#endif
17716
17717 is1%beg = -1; is2%beg = 0; is3%beg = 0
17718 is1%end = m; is2%end = n; is3%end = p
17719
17720#ifdef MFC_DEBUG
17721# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17722 block
17723# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17724 use iso_fortran_env, only: output_unit
17725# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17726
17727# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17728 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))'
17729# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17730
17731# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17732 call flush (output_unit)
17733# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17734 end block
17735# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17736#endif
17737# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17738 allocate (flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
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
17743# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17744#if defined(MFC_OpenACC)
17745# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17746!$acc enter data create(flux_rsx_vf)
17747# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17748#elif defined(MFC_OpenMP)
17749# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17750!$omp target enter data map(always,alloc:flux_rsx_vf)
17751# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17752#endif
17753# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17754#ifdef MFC_DEBUG
17755# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17756 block
17757# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17758 use iso_fortran_env, only: output_unit
17759# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17760
17761# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17762 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))'
17763# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17764
17765# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17766 call flush (output_unit)
17767# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17768 end block
17769# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17770#endif
17771# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17772 allocate (flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
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
17777# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17778#if defined(MFC_OpenACC)
17779# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17780!$acc enter data create(flux_gsrc_rsx_vf)
17781# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17782#elif defined(MFC_OpenMP)
17783# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17784!$omp target enter data map(always,alloc:flux_gsrc_rsx_vf)
17785# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17786#endif
17787# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17788#ifdef MFC_DEBUG
17789# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17790 block
17791# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17792 use iso_fortran_env, only: output_unit
17793# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17794
17795# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17796 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))'
17797# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17798
17799# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17800 call flush (output_unit)
17801# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17802 end block
17803# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17804#endif
17805# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17806 allocate (flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
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
17811# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17812#if defined(MFC_OpenACC)
17813# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17814!$acc enter data create(flux_src_rsx_vf)
17815# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17816#elif defined(MFC_OpenMP)
17817# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17818!$omp target enter data map(always,alloc:flux_src_rsx_vf)
17819# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17820#endif
17821# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17822#ifdef MFC_DEBUG
17823# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17824 block
17825# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17826 use iso_fortran_env, only: output_unit
17827# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17828
17829# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17830 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))'
17831# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17832
17833# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17834 call flush (output_unit)
17835# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17836 end block
17837# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17838#endif
17839# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17840 allocate (vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
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
17845# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17846#if defined(MFC_OpenACC)
17847# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17848!$acc enter data create(vel_src_rsx_vf)
17849# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17850#elif defined(MFC_OpenMP)
17851# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17852!$omp target enter data map(always,alloc:vel_src_rsx_vf)
17853# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17854#endif
17855# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17856 if (qbmm) then
17857#ifdef MFC_DEBUG
17858# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17859 block
17860# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17861 use iso_fortran_env, only: output_unit
17862# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17863
17864# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17865 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))'
17866# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17867
17868# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17869 call flush (output_unit)
17870# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17871 end block
17872# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17873#endif
17874# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17875 allocate (mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
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
17880# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17881#if defined(MFC_OpenACC)
17882# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17883!$acc enter data create(mom_sp_rsx_vf)
17884# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17885#elif defined(MFC_OpenMP)
17886# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17887!$omp target enter data map(always,alloc:mom_sp_rsx_vf)
17888# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17889#endif
17890 end if
17891
17892 if (viscous) then
17893#ifdef MFC_DEBUG
17894# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17895 block
17896# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17897 use iso_fortran_env, only: output_unit
17898# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17899
17900# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17901 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))'
17902# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17903
17904# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17905 call flush (output_unit)
17906# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17907 end block
17908# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17909#endif
17910# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17911 allocate (re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
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
17916# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17917#if defined(MFC_OpenACC)
17918# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17919!$acc enter data create(Re_avg_rsx_vf)
17920# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17921#elif defined(MFC_OpenMP)
17922# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17923!$omp target enter data map(always,alloc:Re_avg_rsx_vf)
17924# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17925#endif
17926# 4013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17927 end if
17928
17929 if (n == 0) return
17930
17931 is1%beg = -1; is2%beg = 0; is3%beg = 0
17932 is1%end = n; is2%end = m; is3%end = p
17933
17934#ifdef MFC_DEBUG
17935# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17936 block
17937# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17938 use iso_fortran_env, only: output_unit
17939# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17940
17941# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17942 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))'
17943# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17944
17945# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17946 call flush (output_unit)
17947# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17948 end block
17949# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17950#endif
17951# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17952 allocate (flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
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
17957# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17958#if defined(MFC_OpenACC)
17959# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17960!$acc enter data create(flux_rsy_vf)
17961# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17962#elif defined(MFC_OpenMP)
17963# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17964!$omp target enter data map(always,alloc:flux_rsy_vf)
17965# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17966#endif
17967# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17968#ifdef MFC_DEBUG
17969# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17970 block
17971# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17972 use iso_fortran_env, only: output_unit
17973# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17974
17975# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17976 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))'
17977# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17978
17979# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17980 call flush (output_unit)
17981# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17982 end block
17983# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17984#endif
17985# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17986 allocate (flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
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
17991# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17992#if defined(MFC_OpenACC)
17993# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17994!$acc enter data create(flux_gsrc_rsy_vf)
17995# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17996#elif defined(MFC_OpenMP)
17997# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17998!$omp target enter data map(always,alloc:flux_gsrc_rsy_vf)
17999# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18000#endif
18001# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18002#ifdef MFC_DEBUG
18003# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18004 block
18005# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18006 use iso_fortran_env, only: output_unit
18007# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18008
18009# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18010 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))'
18011# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18012
18013# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18014 call flush (output_unit)
18015# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18016 end block
18017# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18018#endif
18019# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18020 allocate (flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
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
18025# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18026#if defined(MFC_OpenACC)
18027# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18028!$acc enter data create(flux_src_rsy_vf)
18029# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18030#elif defined(MFC_OpenMP)
18031# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18032!$omp target enter data map(always,alloc:flux_src_rsy_vf)
18033# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18034#endif
18035# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18036#ifdef MFC_DEBUG
18037# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18038 block
18039# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18040 use iso_fortran_env, only: output_unit
18041# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18042
18043# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18044 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))'
18045# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18046
18047# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18048 call flush (output_unit)
18049# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18050 end block
18051# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18052#endif
18053# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18054 allocate (vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
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
18059# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18060#if defined(MFC_OpenACC)
18061# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18062!$acc enter data create(vel_src_rsy_vf)
18063# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18064#elif defined(MFC_OpenMP)
18065# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18066!$omp target enter data map(always,alloc:vel_src_rsy_vf)
18067# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18068#endif
18069# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18070
18071 if (qbmm) then
18072#ifdef MFC_DEBUG
18073# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18074 block
18075# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18076 use iso_fortran_env, only: output_unit
18077# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18078
18079# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18080 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))'
18081# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18082
18083# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18084 call flush (output_unit)
18085# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18086 end block
18087# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18088#endif
18089# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18090 allocate (mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
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
18095# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18096#if defined(MFC_OpenACC)
18097# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18098!$acc enter data create(mom_sp_rsy_vf)
18099# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18100#elif defined(MFC_OpenMP)
18101# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18102!$omp target enter data map(always,alloc:mom_sp_rsy_vf)
18103# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18104#endif
18105 end if
18106
18107 if (viscous) then
18108#ifdef MFC_DEBUG
18109# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18110 block
18111# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18112 use iso_fortran_env, only: output_unit
18113# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18114
18115# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18116 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))'
18117# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18118
18119# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18120 call flush (output_unit)
18121# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18122 end block
18123# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18124#endif
18125# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18126 allocate (re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
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
18131# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18132#if defined(MFC_OpenACC)
18133# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18134!$acc enter data create(Re_avg_rsy_vf)
18135# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18136#elif defined(MFC_OpenMP)
18137# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18138!$omp target enter data map(always,alloc:Re_avg_rsy_vf)
18139# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18140#endif
18141# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18142 end if
18143
18144 if (p == 0) return
18145
18146 is1%beg = -1; is2%beg = 0; is3%beg = 0
18147 is1%end = p; is2%end = n; is3%end = m
18148
18149#ifdef MFC_DEBUG
18150# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18151 block
18152# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18153 use iso_fortran_env, only: output_unit
18154# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18155
18156# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18157 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))'
18158# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18159
18160# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18161 call flush (output_unit)
18162# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18163 end block
18164# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18165#endif
18166# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18167 allocate (flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
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
18172# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18173#if defined(MFC_OpenACC)
18174# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18175!$acc enter data create(flux_rsz_vf)
18176# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18177#elif defined(MFC_OpenMP)
18178# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18179!$omp target enter data map(always,alloc:flux_rsz_vf)
18180# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18181#endif
18182# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18183#ifdef MFC_DEBUG
18184# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18185 block
18186# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18187 use iso_fortran_env, only: output_unit
18188# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18189
18190# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18191 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))'
18192# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18193
18194# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18195 call flush (output_unit)
18196# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18197 end block
18198# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18199#endif
18200# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18201 allocate (flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
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
18206# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18207#if defined(MFC_OpenACC)
18208# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18209!$acc enter data create(flux_gsrc_rsz_vf)
18210# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18211#elif defined(MFC_OpenMP)
18212# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18213!$omp target enter data map(always,alloc:flux_gsrc_rsz_vf)
18214# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18215#endif
18216# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18217#ifdef MFC_DEBUG
18218# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18219 block
18220# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18221 use iso_fortran_env, only: output_unit
18222# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18223
18224# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18225 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))'
18226# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18227
18228# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18229 call flush (output_unit)
18230# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18231 end block
18232# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18233#endif
18234# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18235 allocate (flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
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
18240# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18241#if defined(MFC_OpenACC)
18242# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18243!$acc enter data create(flux_src_rsz_vf)
18244# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18245#elif defined(MFC_OpenMP)
18246# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18247!$omp target enter data map(always,alloc:flux_src_rsz_vf)
18248# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18249#endif
18250# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18251#ifdef MFC_DEBUG
18252# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18253 block
18254# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18255 use iso_fortran_env, only: output_unit
18256# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18257
18258# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18259 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))'
18260# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18261
18262# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18263 call flush (output_unit)
18264# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18265 end block
18266# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18267#endif
18268# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18269 allocate (vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
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
18274# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18275#if defined(MFC_OpenACC)
18276# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18277!$acc enter data create(vel_src_rsz_vf)
18278# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18279#elif defined(MFC_OpenMP)
18280# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18281!$omp target enter data map(always,alloc:vel_src_rsz_vf)
18282# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18283#endif
18284# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18285
18286 if (qbmm) then
18287#ifdef MFC_DEBUG
18288# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18289 block
18290# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18291 use iso_fortran_env, only: output_unit
18292# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18293
18294# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18295 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))'
18296# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18297
18298# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18299 call flush (output_unit)
18300# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18301 end block
18302# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18303#endif
18304# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18305 allocate (mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
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
18310# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18311#if defined(MFC_OpenACC)
18312# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18313!$acc enter data create(mom_sp_rsz_vf)
18314# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18315#elif defined(MFC_OpenMP)
18316# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18317!$omp target enter data map(always,alloc:mom_sp_rsz_vf)
18318# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18319#endif
18320 end if
18321
18322 if (viscous) then
18323#ifdef MFC_DEBUG
18324# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18325 block
18326# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18327 use iso_fortran_env, only: output_unit
18328# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18329
18330# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18331 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))'
18332# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18333
18334# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18335 call flush (output_unit)
18336# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18337 end block
18338# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18339#endif
18340# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18341 allocate (re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
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
18346# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18347#if defined(MFC_OpenACC)
18348# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18349!$acc enter data create(Re_avg_rsz_vf)
18350# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18351#elif defined(MFC_OpenMP)
18352# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18353!$omp target enter data map(always,alloc:Re_avg_rsz_vf)
18354# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18355#endif
18356# 4069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18357 end if
18358
18359 end subroutine s_initialize_riemann_solvers_module
18360
18361 !> The purpose of this subroutine is to populate the buffers
18362 !! of the left and right Riemann states variables, depending
18363 !! on the boundary conditions.
18364 !! @param qL_prim_rsx_vf Left WENO-reconstructed cell-boundary values (x-dir)
18365 !! @param qL_prim_rsy_vf Left WENO-reconstructed cell-boundary values (y-dir)
18366 !! @param qL_prim_rsz_vf Left WENO-reconstructed cell-boundary values (z-dir)
18367 !! @param dqL_prim_dx_vf The left WENO-reconstructed cell-boundary values of the
18368 !! first-order x-dir spatial derivatives
18369 !! @param dqL_prim_dy_vf The left WENO-reconstructed cell-boundary values of the
18370 !! first-order y-dir spatial derivatives
18371 !! @param dqL_prim_dz_vf The left WENO-reconstructed cell-boundary values of the
18372 !! first-order z-dir spatial derivatives
18373 !! @param qR_prim_rsx_vf Right WENO-reconstructed cell-boundary values (x-dir)
18374 !! @param qR_prim_rsy_vf Right WENO-reconstructed cell-boundary values (y-dir)
18375 !! @param qR_prim_rsz_vf Right WENO-reconstructed cell-boundary values (z-dir)
18376 !! @param dqR_prim_dx_vf The right WENO-reconstructed cell-boundary values of the
18377 !! first-order x-dir spatial derivatives
18378 !! @param dqR_prim_dy_vf The right WENO-reconstructed cell-boundary values of the
18379 !! first-order y-dir spatial derivatives
18380 !! @param dqR_prim_dz_vf The right WENO-reconstructed cell-boundary values of the
18381 !! first-order z-dir spatial derivatives
18382 !! @param norm_dir Dir. splitting direction
18383 !! @param ix Index bounds in the x-dir
18384 !! @param iy Index bounds in the y-dir
18385 !! @param iz Index bounds in the z-dir
18386 subroutine s_populate_riemann_states_variables_buffers( &
18387 qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
18388 dqL_prim_dy_vf, &
18389 dqL_prim_dz_vf, &
18390 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
18391 dqR_prim_dy_vf, &
18392 dqR_prim_dz_vf, &
18393 norm_dir, ix, iy, iz)
18394
18395 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
18396
18397 type(scalar_field), &
18398 allocatable, dimension(:), &
18399 intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, &
18400 dqL_prim_dy_vf, dqR_prim_dy_vf, &
18401 dqL_prim_dz_vf, dqR_prim_dz_vf
18402
18403 integer, intent(in) :: norm_dir
18404 type(int_bounds_info), intent(in) :: ix, iy, iz
18405
18406 integer :: i, j, k, l !< Generic loop iterator
18407
18408 if (norm_dir == 1) then
18409 is1 = ix; is2 = iy; is3 = iz
18410 dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/)
18411 elseif (norm_dir == 2) then
18412 is1 = iy; is2 = ix; is3 = iz
18413 dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/)
18414 else
18415 is1 = iz; is2 = iy; is3 = ix
18416 dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/)
18417 end if
18418
18419
18420# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18421#if defined(MFC_OpenACC)
18422# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18423!$acc update device(is1, is2, is3)
18424# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18425#elif defined(MFC_OpenMP)
18426# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18427!$omp target update to(is1, is2, is3)
18428# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18429#endif
18430
18431 if (elasticity) then
18432 if (norm_dir == 1) then
18433 dir_idx_tau = (/1, 2, 4/)
18434 else if (norm_dir == 2) then
18435 dir_idx_tau = (/3, 2, 5/)
18436 else
18437 dir_idx_tau = (/6, 4, 5/)
18438 end if
18439 end if
18440
18441 isx = ix; isy = iy; isz = iz
18442 ! for stuff in the same module
18443
18444# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18445#if defined(MFC_OpenACC)
18446# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18447!$acc update device(isx, isy, isz)
18448# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18449#elif defined(MFC_OpenMP)
18450# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18451!$omp target update to(isx, isy, isz)
18452# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18453#endif
18454 ! for stuff in different modules
18455
18456# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18457#if defined(MFC_OpenACC)
18458# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18459!$acc update device(dir_idx, dir_flg, dir_idx_tau)
18460# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18461#elif defined(MFC_OpenMP)
18462# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18463!$omp target update to(dir_idx, dir_flg, dir_idx_tau)
18464# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18465#endif
18466
18467 ! Population of Buffers in x-direction
18468 if (norm_dir == 1) then
18469
18470 if (bc_x%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
18471
18472# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18473
18474# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18475#if defined(MFC_OpenACC)
18476# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18477!$acc parallel loop collapse(3) gang vector default(present)
18478# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18479#elif defined(MFC_OpenMP)
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
18486# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18487!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18488# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18489#endif
18490# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18491
18492 do i = 1, sys_size
18493 do l = is3%beg, is3%end
18494 do k = is2%beg, is2%end
18495 ql_prim_rsx_vf(-1, k, l, i) = &
18496 qr_prim_rsx_vf(0, k, l, i)
18497 end do
18498 end do
18499 end do
18500
18501# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18502
18503# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18504#if defined(MFC_OpenACC)
18505# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18506!$acc end parallel loop
18507# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18508#elif defined(MFC_OpenMP)
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
18513# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18514!$omp end target teams loop
18515# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18516#endif
18517# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18518
18519
18520 if (viscous .or. dummy) then
18521
18522# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18523
18524# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18525#if defined(MFC_OpenACC)
18526# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18527!$acc parallel loop collapse(3) gang vector default(present)
18528# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18529#elif defined(MFC_OpenMP)
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
18536# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18537!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18538# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18539#endif
18540# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18541
18542 do i = momxb, momxe
18543 do l = isz%beg, isz%end
18544 do k = isy%beg, isy%end
18545
18546 dql_prim_dx_vf(i)%sf(-1, k, l) = &
18547 dqr_prim_dx_vf(i)%sf(0, k, l)
18548 end do
18549 end do
18550 end do
18551
18552# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18553
18554# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18555#if defined(MFC_OpenACC)
18556# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18557!$acc end parallel loop
18558# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18559#elif defined(MFC_OpenMP)
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
18564# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18565!$omp end target teams loop
18566# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18567#endif
18568# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18569
18570
18571 if (n > 0) then
18572
18573# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18574
18575# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18576#if defined(MFC_OpenACC)
18577# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18578!$acc parallel loop collapse(3) gang vector default(present)
18579# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18580#elif defined(MFC_OpenMP)
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
18587# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18588!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18589# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18590#endif
18591# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18592
18593 do i = momxb, momxe
18594 do l = isz%beg, isz%end
18595 do k = isy%beg, isy%end
18596
18597 dql_prim_dy_vf(i)%sf(-1, k, l) = &
18598 dqr_prim_dy_vf(i)%sf(0, k, l)
18599 end do
18600 end do
18601 end do
18602
18603# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18604
18605# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18606#if defined(MFC_OpenACC)
18607# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18608!$acc end parallel loop
18609# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18610#elif defined(MFC_OpenMP)
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
18615# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18616!$omp end target teams loop
18617# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18618#endif
18619# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18620
18621
18622 if (p > 0) then
18623
18624# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18625
18626# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18627#if defined(MFC_OpenACC)
18628# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18629!$acc parallel loop collapse(3) gang vector default(present)
18630# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18631#elif defined(MFC_OpenMP)
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
18638# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18639!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18640# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18641#endif
18642# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18643
18644 do i = momxb, momxe
18645 do l = isz%beg, isz%end
18646 do k = isy%beg, isy%end
18647
18648 dql_prim_dz_vf(i)%sf(-1, k, l) = &
18649 dqr_prim_dz_vf(i)%sf(0, k, l)
18650 end do
18651 end do
18652 end do
18653
18654# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18655
18656# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18657#if defined(MFC_OpenACC)
18658# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18659!$acc end parallel loop
18660# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18661#elif defined(MFC_OpenMP)
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
18666# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18667!$omp end target teams loop
18668# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18669#endif
18670# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18671
18672 end if
18673
18674 end if
18675
18676 end if
18677
18678 end if
18679
18680 if (bc_x%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
18681
18682
18683# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18684
18685# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18686#if defined(MFC_OpenACC)
18687# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18688!$acc parallel loop collapse(3) gang vector default(present)
18689# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18690#elif defined(MFC_OpenMP)
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
18697# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18698!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18699# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18700#endif
18701# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18702
18703 do i = 1, sys_size
18704 do l = is3%beg, is3%end
18705 do k = is2%beg, is2%end
18706 qr_prim_rsx_vf(m + 1, k, l, i) = &
18707 ql_prim_rsx_vf(m, k, l, i)
18708 end do
18709 end do
18710 end do
18711
18712# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18713
18714# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18715#if defined(MFC_OpenACC)
18716# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18717!$acc end parallel loop
18718# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18719#elif defined(MFC_OpenMP)
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
18724# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18725!$omp end target teams loop
18726# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18727#endif
18728# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18729
18730
18731 if (viscous .or. dummy) then
18732
18733
18734# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18735
18736# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18737#if defined(MFC_OpenACC)
18738# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18739!$acc parallel loop collapse(3) gang vector default(present)
18740# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18741#elif defined(MFC_OpenMP)
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
18748# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18749!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18750# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18751#endif
18752# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18753
18754 do i = momxb, momxe
18755 do l = isz%beg, isz%end
18756 do k = isy%beg, isy%end
18757
18758 dqr_prim_dx_vf(i)%sf(m + 1, k, l) = &
18759 dql_prim_dx_vf(i)%sf(m, k, l)
18760 end do
18761 end do
18762 end do
18763
18764# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18765
18766# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18767#if defined(MFC_OpenACC)
18768# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18769!$acc end parallel loop
18770# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18771#elif defined(MFC_OpenMP)
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
18776# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18777!$omp end target teams loop
18778# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18779#endif
18780# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18781
18782
18783 if (n > 0) then
18784
18785# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18786
18787# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18788#if defined(MFC_OpenACC)
18789# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18790!$acc parallel loop collapse(3) gang vector default(present)
18791# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18792#elif defined(MFC_OpenMP)
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
18799# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18800!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18801# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18802#endif
18803# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18804
18805 do i = momxb, momxe
18806 do l = isz%beg, isz%end
18807 do k = isy%beg, isy%end
18808
18809 dqr_prim_dy_vf(i)%sf(m + 1, k, l) = &
18810 dql_prim_dy_vf(i)%sf(m, k, l)
18811 end do
18812 end do
18813 end do
18814
18815# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18816
18817# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18818#if defined(MFC_OpenACC)
18819# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18820!$acc end parallel loop
18821# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18822#elif defined(MFC_OpenMP)
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
18827# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18828!$omp end target teams loop
18829# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18830#endif
18831# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18832
18833
18834 if (p > 0) then
18835
18836# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18837
18838# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18839#if defined(MFC_OpenACC)
18840# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18841!$acc parallel loop collapse(3) gang vector default(present)
18842# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18843#elif defined(MFC_OpenMP)
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
18850# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18851!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18852# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18853#endif
18854# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18855
18856 do i = momxb, momxe
18857 do l = isz%beg, isz%end
18858 do k = isy%beg, isy%end
18859
18860 dqr_prim_dz_vf(i)%sf(m + 1, k, l) = &
18861 dql_prim_dz_vf(i)%sf(m, k, l)
18862 end do
18863 end do
18864 end do
18865
18866# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18867
18868# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18869#if defined(MFC_OpenACC)
18870# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18871!$acc end parallel loop
18872# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18873#elif defined(MFC_OpenMP)
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
18878# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18879!$omp end target teams loop
18880# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18881#endif
18882# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18883
18884 end if
18885
18886 end if
18887
18888 end if
18889
18890 end if
18891 ! END: Population of Buffers in x-direction
18892
18893 ! Population of Buffers in y-direction
18894 elseif (norm_dir == 2) then
18895
18896 if (bc_y%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
18897
18898# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18899
18900# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18901#if defined(MFC_OpenACC)
18902# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18903!$acc parallel loop collapse(3) gang vector default(present)
18904# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18905#elif defined(MFC_OpenMP)
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
18912# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18913!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18914# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18915#endif
18916# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18917
18918 do i = 1, sys_size
18919 do l = is3%beg, is3%end
18920 do k = is2%beg, is2%end
18921 ql_prim_rsy_vf(-1, k, l, i) = &
18922 qr_prim_rsy_vf(0, k, l, i)
18923 end do
18924 end do
18925 end do
18926
18927# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18928
18929# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18930#if defined(MFC_OpenACC)
18931# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18932!$acc end parallel loop
18933# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18934#elif defined(MFC_OpenMP)
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
18939# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18940!$omp end target teams loop
18941# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18942#endif
18943# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18944
18945
18946 if (viscous .or. dummy) then
18947
18948
18949# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18950
18951# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18952#if defined(MFC_OpenACC)
18953# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18954!$acc parallel loop collapse(3) gang vector default(present)
18955# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18956#elif defined(MFC_OpenMP)
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
18963# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18964!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18965# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18966#endif
18967# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18968
18969 do i = momxb, momxe
18970 do l = isz%beg, isz%end
18971 do j = isx%beg, isx%end
18972 dql_prim_dx_vf(i)%sf(j, -1, l) = &
18973 dqr_prim_dx_vf(i)%sf(j, 0, l)
18974 end do
18975 end do
18976 end do
18977
18978# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18979
18980# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18981#if defined(MFC_OpenACC)
18982# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18983!$acc end parallel loop
18984# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18985#elif defined(MFC_OpenMP)
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
18990# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18991!$omp end target teams loop
18992# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18993#endif
18994# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18995
18996
18997
18998# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18999
19000# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19001#if defined(MFC_OpenACC)
19002# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19003!$acc parallel loop collapse(3) gang vector default(present)
19004# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19005#elif defined(MFC_OpenMP)
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
19012# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19013!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19014# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19015#endif
19016# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19017
19018 do i = momxb, momxe
19019 do l = isz%beg, isz%end
19020 do j = isx%beg, isx%end
19021 dql_prim_dy_vf(i)%sf(j, -1, l) = &
19022 dqr_prim_dy_vf(i)%sf(j, 0, l)
19023 end do
19024 end do
19025 end do
19026
19027# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19028
19029# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19030#if defined(MFC_OpenACC)
19031# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19032!$acc end parallel loop
19033# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19034#elif defined(MFC_OpenMP)
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
19039# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19040!$omp end target teams loop
19041# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19042#endif
19043# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19044
19045
19046 if (p > 0) then
19047
19048# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19049
19050# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19051#if defined(MFC_OpenACC)
19052# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19053!$acc parallel loop collapse(3) gang vector default(present)
19054# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19055#elif defined(MFC_OpenMP)
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
19062# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19063!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19064# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19065#endif
19066# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19067
19068 do i = momxb, momxe
19069 do l = isz%beg, isz%end
19070 do j = isx%beg, isx%end
19071 dql_prim_dz_vf(i)%sf(j, -1, l) = &
19072 dqr_prim_dz_vf(i)%sf(j, 0, l)
19073 end do
19074 end do
19075 end do
19076
19077# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19078
19079# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19080#if defined(MFC_OpenACC)
19081# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19082!$acc end parallel loop
19083# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19084#elif defined(MFC_OpenMP)
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
19089# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19090!$omp end target teams loop
19091# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19092#endif
19093# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19094
19095 end if
19096
19097 end if
19098
19099 end if
19100
19101 if (bc_y%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
19102
19103
19104# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19105
19106# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19107#if defined(MFC_OpenACC)
19108# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19109!$acc parallel loop collapse(3) gang vector default(present)
19110# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19111#elif defined(MFC_OpenMP)
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
19118# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19119!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19120# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19121#endif
19122# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19123
19124 do i = 1, sys_size
19125 do l = is3%beg, is3%end
19126 do k = is2%beg, is2%end
19127 qr_prim_rsy_vf(n + 1, k, l, i) = &
19128 ql_prim_rsy_vf(n, k, l, i)
19129 end do
19130 end do
19131 end do
19132
19133# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19134
19135# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19136#if defined(MFC_OpenACC)
19137# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19138!$acc end parallel loop
19139# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19140#elif defined(MFC_OpenMP)
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
19145# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19146!$omp end target teams loop
19147# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19148#endif
19149# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19150
19151
19152 if (viscous .or. dummy) then
19153
19154
19155# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19156
19157# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19158#if defined(MFC_OpenACC)
19159# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19160!$acc parallel loop collapse(3) gang vector default(present)
19161# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19162#elif defined(MFC_OpenMP)
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
19169# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19170!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19171# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19172#endif
19173# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19174
19175 do i = momxb, momxe
19176 do l = isz%beg, isz%end
19177 do j = isx%beg, isx%end
19178 dqr_prim_dx_vf(i)%sf(j, n + 1, l) = &
19179 dql_prim_dx_vf(i)%sf(j, n, l)
19180 end do
19181 end do
19182 end do
19183
19184# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19185
19186# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19187#if defined(MFC_OpenACC)
19188# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19189!$acc end parallel loop
19190# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19191#elif defined(MFC_OpenMP)
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
19196# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19197!$omp end target teams loop
19198# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19199#endif
19200# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19201
19202
19203
19204# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19205
19206# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19207#if defined(MFC_OpenACC)
19208# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19209!$acc parallel loop collapse(3) gang vector default(present)
19210# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19211#elif defined(MFC_OpenMP)
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
19218# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19219!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19220# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19221#endif
19222# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19223
19224 do i = momxb, momxe
19225 do l = isz%beg, isz%end
19226 do j = isx%beg, isx%end
19227 dqr_prim_dy_vf(i)%sf(j, n + 1, l) = &
19228 dql_prim_dy_vf(i)%sf(j, n, l)
19229 end do
19230 end do
19231 end do
19232
19233# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19234
19235# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19236#if defined(MFC_OpenACC)
19237# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19238!$acc end parallel loop
19239# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19240#elif defined(MFC_OpenMP)
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
19245# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19246!$omp end target teams loop
19247# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19248#endif
19249# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19250
19251
19252 if (p > 0) then
19253
19254# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19255
19256# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19257#if defined(MFC_OpenACC)
19258# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19259!$acc parallel loop collapse(3) gang vector default(present)
19260# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19261#elif defined(MFC_OpenMP)
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
19268# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19269!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19270# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19271#endif
19272# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19273
19274 do i = momxb, momxe
19275 do l = isz%beg, isz%end
19276 do j = isx%beg, isx%end
19277 dqr_prim_dz_vf(i)%sf(j, n + 1, l) = &
19278 dql_prim_dz_vf(i)%sf(j, n, l)
19279 end do
19280 end do
19281 end do
19282
19283# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19284
19285# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19286#if defined(MFC_OpenACC)
19287# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19288!$acc end parallel loop
19289# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19290#elif defined(MFC_OpenMP)
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
19295# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19296!$omp end target teams loop
19297# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19298#endif
19299# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19300
19301 end if
19302
19303 end if
19304
19305 end if
19306 ! END: Population of Buffers in y-direction
19307
19308 ! Population of Buffers in z-direction
19309 else
19310
19311 if (bc_z%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
19312
19313# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19314
19315# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19316#if defined(MFC_OpenACC)
19317# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19318!$acc parallel loop collapse(3) gang vector default(present)
19319# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19320#elif defined(MFC_OpenMP)
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
19327# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19328!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19329# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19330#endif
19331# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19332
19333 do i = 1, sys_size
19334 do l = is3%beg, is3%end
19335 do k = is2%beg, is2%end
19336 ql_prim_rsz_vf(-1, k, l, i) = &
19337 qr_prim_rsz_vf(0, k, l, i)
19338 end do
19339 end do
19340 end do
19341
19342# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19343
19344# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19345#if defined(MFC_OpenACC)
19346# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19347!$acc end parallel loop
19348# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19349#elif defined(MFC_OpenMP)
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
19354# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19355!$omp end target teams loop
19356# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19357#endif
19358# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19359
19360
19361 if (viscous .or. dummy) then
19362
19363# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19364
19365# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19366#if defined(MFC_OpenACC)
19367# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19368!$acc parallel loop collapse(3) gang vector default(present)
19369# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19370#elif defined(MFC_OpenMP)
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
19377# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19378!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19379# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19380#endif
19381# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19382
19383 do i = momxb, momxe
19384 do k = isy%beg, isy%end
19385 do j = isx%beg, isx%end
19386 dql_prim_dx_vf(i)%sf(j, k, -1) = &
19387 dqr_prim_dx_vf(i)%sf(j, k, 0)
19388 end do
19389 end do
19390 end do
19391
19392# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19393
19394# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19395#if defined(MFC_OpenACC)
19396# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19397!$acc end parallel loop
19398# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19399#elif defined(MFC_OpenMP)
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
19404# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19405!$omp end target teams loop
19406# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19407#endif
19408# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19409
19410
19411# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19412
19413# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19414#if defined(MFC_OpenACC)
19415# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19416!$acc parallel loop collapse(3) gang vector default(present)
19417# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19418#elif defined(MFC_OpenMP)
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
19425# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19426!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19427# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19428#endif
19429# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19430
19431 do i = momxb, momxe
19432 do k = isy%beg, isy%end
19433 do j = isx%beg, isx%end
19434 dql_prim_dy_vf(i)%sf(j, k, -1) = &
19435 dqr_prim_dy_vf(i)%sf(j, k, 0)
19436 end do
19437 end do
19438 end do
19439
19440# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19441
19442# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19443#if defined(MFC_OpenACC)
19444# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19445!$acc end parallel loop
19446# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19447#elif defined(MFC_OpenMP)
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
19452# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19453!$omp end target teams loop
19454# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19455#endif
19456# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19457
19458
19459# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19460
19461# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19462#if defined(MFC_OpenACC)
19463# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19464!$acc parallel loop collapse(3) gang vector default(present)
19465# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19466#elif defined(MFC_OpenMP)
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
19473# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19474!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19475# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19476#endif
19477# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19478
19479 do i = momxb, momxe
19480 do k = isy%beg, isy%end
19481 do j = isx%beg, isx%end
19482 dql_prim_dz_vf(i)%sf(j, k, -1) = &
19483 dqr_prim_dz_vf(i)%sf(j, k, 0)
19484 end do
19485 end do
19486 end do
19487
19488# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19489
19490# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19491#if defined(MFC_OpenACC)
19492# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19493!$acc end parallel loop
19494# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19495#elif defined(MFC_OpenMP)
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
19500# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19501!$omp end target teams loop
19502# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19503#endif
19504# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19505
19506 end if
19507
19508 end if
19509
19510 if (bc_z%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
19511
19512
19513# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19514
19515# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19516#if defined(MFC_OpenACC)
19517# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19518!$acc parallel loop collapse(3) gang vector default(present)
19519# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19520#elif defined(MFC_OpenMP)
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
19527# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19528!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19529# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19530#endif
19531# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19532
19533 do i = 1, sys_size
19534 do l = is3%beg, is3%end
19535 do k = is2%beg, is2%end
19536 qr_prim_rsz_vf(p + 1, k, l, i) = &
19537 ql_prim_rsz_vf(p, k, l, i)
19538 end do
19539 end do
19540 end do
19541
19542# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19543
19544# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19545#if defined(MFC_OpenACC)
19546# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19547!$acc end parallel loop
19548# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19549#elif defined(MFC_OpenMP)
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
19554# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19555!$omp end target teams loop
19556# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19557#endif
19558# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19559
19560
19561 if (viscous .or. dummy) then
19562
19563# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19564
19565# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19566#if defined(MFC_OpenACC)
19567# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19568!$acc parallel loop collapse(3) gang vector default(present)
19569# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19570#elif defined(MFC_OpenMP)
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
19577# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19578!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19579# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19580#endif
19581# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19582
19583 do i = momxb, momxe
19584 do k = isy%beg, isy%end
19585 do j = isx%beg, isx%end
19586 dqr_prim_dx_vf(i)%sf(j, k, p + 1) = &
19587 dql_prim_dx_vf(i)%sf(j, k, p)
19588 end do
19589 end do
19590 end do
19591
19592# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19593
19594# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19595#if defined(MFC_OpenACC)
19596# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19597!$acc end parallel loop
19598# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19599#elif defined(MFC_OpenMP)
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
19604# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19605!$omp end target teams loop
19606# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19607#endif
19608# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19609
19610
19611
19612# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19613
19614# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19615#if defined(MFC_OpenACC)
19616# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19617!$acc parallel loop collapse(3) gang vector default(present)
19618# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19619#elif defined(MFC_OpenMP)
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
19626# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19627!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19628# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19629#endif
19630# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19631
19632 do i = momxb, momxe
19633 do k = isy%beg, isy%end
19634 do j = isx%beg, isx%end
19635 dqr_prim_dy_vf(i)%sf(j, k, p + 1) = &
19636 dql_prim_dy_vf(i)%sf(j, k, p)
19637 end do
19638 end do
19639 end do
19640
19641# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19642
19643# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19644#if defined(MFC_OpenACC)
19645# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19646!$acc end parallel loop
19647# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19648#elif defined(MFC_OpenMP)
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
19653# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19654!$omp end target teams loop
19655# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19656#endif
19657# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19658
19659
19660
19661# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19662
19663# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19664#if defined(MFC_OpenACC)
19665# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19666!$acc parallel loop collapse(3) gang vector default(present)
19667# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19668#elif defined(MFC_OpenMP)
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
19675# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19676!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19677# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19678#endif
19679# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19680
19681 do i = momxb, momxe
19682 do k = isy%beg, isy%end
19683 do j = isx%beg, isx%end
19684 dqr_prim_dz_vf(i)%sf(j, k, p + 1) = &
19685 dql_prim_dz_vf(i)%sf(j, k, p)
19686 end do
19687 end do
19688 end do
19689
19690# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19691
19692# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19693#if defined(MFC_OpenACC)
19694# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19695!$acc end parallel loop
19696# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19697#elif defined(MFC_OpenMP)
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
19702# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19703!$omp end target teams loop
19704# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19705#endif
19706# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19707
19708 end if
19709
19710 end if
19711
19712 end if
19713 ! END: Population of Buffers in z-direction
19714
19715 end subroutine s_populate_riemann_states_variables_buffers
19716
19717 !> The computation of parameters, the allocation of memory,
19718 !! the association of pointers and/or the execution of any
19719 !! other procedures needed to configure the chosen Riemann
19720 !! solver algorithm.
19721 !! @param flux_src_vf Intra-cell fluxes sources
19722 !! @param norm_dir Dir. splitting direction
19723 subroutine s_initialize_riemann_solver( &
19724 flux_src_vf, &
19725 norm_dir)
19726
19727 type(scalar_field), &
19728 dimension(sys_size), &
19729 intent(inout) :: flux_src_vf
19730
19731 integer, intent(in) :: norm_dir
19732
19733 integer :: i, j, k, l ! Generic loop iterators
19734
19735 ! Reshaping Inputted Data in x-direction
19736
19737 if (norm_dir == 1) then
19738
19739 if (viscous .or. (surface_tension) .or. dummy) then
19740
19741
19742# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19743
19744# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19745#if defined(MFC_OpenACC)
19746# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19747!$acc parallel loop collapse(4) gang vector default(present)
19748# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19749#elif defined(MFC_OpenMP)
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
19756# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19757!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19758# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19759#endif
19760# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19761
19762 do i = momxb, e_idx
19763 do l = is3%beg, is3%end
19764 do k = is2%beg, is2%end
19765 do j = is1%beg, is1%end
19766 flux_src_vf(i)%sf(j, k, l) = 0._wp
19767 end do
19768 end do
19769 end do
19770 end do
19771
19772# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19773
19774# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19775#if defined(MFC_OpenACC)
19776# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19777!$acc end parallel loop
19778# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19779#elif defined(MFC_OpenMP)
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
19784# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19785!$omp end target teams loop
19786# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19787#endif
19788# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19789
19790 end if
19791
19792 if (chem_params%diffusion) then
19793
19794# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19795
19796# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19797#if defined(MFC_OpenACC)
19798# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19799!$acc parallel loop collapse(4) gang vector default(present)
19800# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19801#elif defined(MFC_OpenMP)
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
19808# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19809!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19810# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19811#endif
19812# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19813
19814 do i = e_idx, chemxe
19815 do l = is3%beg, is3%end
19816 do k = is2%beg, is2%end
19817 do j = is1%beg, is1%end
19818 if (i == e_idx .or. i >= chemxb) then
19819 flux_src_vf(i)%sf(j, k, l) = 0._wp
19820 end if
19821 end do
19822 end do
19823 end do
19824 end do
19825
19826# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19827
19828# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19829#if defined(MFC_OpenACC)
19830# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19831!$acc end parallel loop
19832# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19833#elif defined(MFC_OpenMP)
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
19838# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19839!$omp end target teams loop
19840# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19841#endif
19842# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19843
19844 end if
19845
19846 if (qbmm) then
19847
19848# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19849
19850# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19851#if defined(MFC_OpenACC)
19852# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19853!$acc parallel loop collapse(4) gang vector default(present)
19854# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19855#elif defined(MFC_OpenMP)
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
19862# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19863!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19864# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19865#endif
19866# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19867
19868 do i = 1, 4
19869 do l = is3%beg, is3%end
19870 do k = is2%beg, is2%end
19871 do j = is1%beg, is1%end + 1
19872 mom_sp_rsx_vf(j, k, l, i) = mom_sp(i)%sf(j, k, l)
19873 end do
19874 end do
19875 end do
19876 end do
19877
19878# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19879
19880# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19881#if defined(MFC_OpenACC)
19882# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19883!$acc end parallel loop
19884# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19885#elif defined(MFC_OpenMP)
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
19890# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19891!$omp end target teams loop
19892# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19893#endif
19894# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19895
19896 end if
19897
19898 ! Reshaping Inputted Data in y-direction
19899 elseif (norm_dir == 2) then
19900
19901 if (viscous .or. (surface_tension) .or. dummy) then
19902
19903# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19904
19905# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19906#if defined(MFC_OpenACC)
19907# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19908!$acc parallel loop collapse(4) gang vector default(present)
19909# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19910#elif defined(MFC_OpenMP)
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
19917# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19918!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19919# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19920#endif
19921# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19922
19923 do i = momxb, e_idx
19924 do l = is3%beg, is3%end
19925 do j = is1%beg, is1%end
19926 do k = is2%beg, is2%end
19927 flux_src_vf(i)%sf(k, j, l) = 0._wp
19928 end do
19929 end do
19930 end do
19931 end do
19932
19933# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19934
19935# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19936#if defined(MFC_OpenACC)
19937# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19938!$acc end parallel loop
19939# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19940#elif defined(MFC_OpenMP)
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
19945# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19946!$omp end target teams loop
19947# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19948#endif
19949# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19950
19951 end if
19952
19953 if (chem_params%diffusion) then
19954
19955# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19956
19957# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19958#if defined(MFC_OpenACC)
19959# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19960!$acc parallel loop collapse(4) gang vector default(present)
19961# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19962#elif defined(MFC_OpenMP)
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
19969# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19970!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19971# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19972#endif
19973# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19974
19975 do i = e_idx, chemxe
19976 do l = is3%beg, is3%end
19977 do j = is1%beg, is1%end
19978 do k = is2%beg, is2%end
19979 if (i == e_idx .or. i >= chemxb) then
19980 flux_src_vf(i)%sf(k, j, l) = 0._wp
19981 end if
19982 end do
19983 end do
19984 end do
19985 end do
19986
19987# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19988
19989# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19990#if defined(MFC_OpenACC)
19991# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19992!$acc end parallel loop
19993# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19994#elif defined(MFC_OpenMP)
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
19999# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20000!$omp end target teams loop
20001# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20002#endif
20003# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20004
20005 end if
20006
20007 if (qbmm) then
20008
20009# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20010
20011# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20012#if defined(MFC_OpenACC)
20013# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20014!$acc parallel loop collapse(4) gang vector default(present)
20015# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20016#elif defined(MFC_OpenMP)
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
20023# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20024!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20025# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20026#endif
20027# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20028
20029 do i = 1, 4
20030 do l = is3%beg, is3%end
20031 do k = is2%beg, is2%end
20032 do j = is1%beg, is1%end + 1
20033 mom_sp_rsy_vf(j, k, l, i) = mom_sp(i)%sf(k, j, l)
20034 end do
20035 end do
20036 end do
20037 end do
20038
20039# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20040
20041# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20042#if defined(MFC_OpenACC)
20043# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20044!$acc end parallel loop
20045# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20046#elif defined(MFC_OpenMP)
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
20051# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20052!$omp end target teams loop
20053# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20054#endif
20055# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20056
20057 end if
20058
20059 ! Reshaping Inputted Data in z-direction
20060 else
20061
20062 if (viscous .or. (surface_tension) .or. dummy) then
20063
20064# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20065
20066# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20067#if defined(MFC_OpenACC)
20068# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20069!$acc parallel loop collapse(4) gang vector default(present)
20070# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20071#elif defined(MFC_OpenMP)
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
20078# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20079!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20080# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20081#endif
20082# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20083
20084 do i = momxb, e_idx
20085 do j = is1%beg, is1%end
20086 do k = is2%beg, is2%end
20087 do l = is3%beg, is3%end
20088 flux_src_vf(i)%sf(l, k, j) = 0._wp
20089 end do
20090 end do
20091 end do
20092 end do
20093
20094# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20095
20096# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20097#if defined(MFC_OpenACC)
20098# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20099!$acc end parallel loop
20100# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20101#elif defined(MFC_OpenMP)
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
20106# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20107!$omp end target teams loop
20108# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20109#endif
20110# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20111
20112 end if
20113
20114 if (chem_params%diffusion) then
20115
20116# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20117
20118# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20119#if defined(MFC_OpenACC)
20120# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20121!$acc parallel loop collapse(4) gang vector default(present)
20122# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20123#elif defined(MFC_OpenMP)
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
20130# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20131!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20132# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20133#endif
20134# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20135
20136 do i = e_idx, chemxe
20137 do j = is1%beg, is1%end
20138 do k = is2%beg, is2%end
20139 do l = is3%beg, is3%end
20140 if (i == e_idx .or. i >= chemxb) then
20141 flux_src_vf(i)%sf(l, k, j) = 0._wp
20142 end if
20143 end do
20144 end do
20145 end do
20146 end do
20147
20148# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20149
20150# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20151#if defined(MFC_OpenACC)
20152# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20153!$acc end parallel loop
20154# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20155#elif defined(MFC_OpenMP)
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
20160# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20161!$omp end target teams loop
20162# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20163#endif
20164# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20165
20166 end if
20167
20168 if (qbmm) then
20169
20170# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20171
20172# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20173#if defined(MFC_OpenACC)
20174# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20175!$acc parallel loop collapse(4) gang vector default(present)
20176# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20177#elif defined(MFC_OpenMP)
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
20184# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20185!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20186# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20187#endif
20188# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20189
20190 do i = 1, 4
20191 do l = is3%beg, is3%end
20192 do k = is2%beg, is2%end
20193 do j = is1%beg, is1%end + 1
20194 mom_sp_rsz_vf(j, k, l, i) = mom_sp(i)%sf(l, k, j)
20195 end do
20196 end do
20197 end do
20198 end do
20199
20200# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20201
20202# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20203#if defined(MFC_OpenACC)
20204# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20205!$acc end parallel loop
20206# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20207#elif defined(MFC_OpenMP)
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
20212# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20213!$omp end target teams loop
20214# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20215#endif
20216# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20217
20218 end if
20219
20220 end if
20221
20222 end subroutine s_initialize_riemann_solver
20223
20224 !> @brief Computes cylindrical viscous source flux contributions for momentum and energy.
20225 !! Calculates Cartesian components of the stress tensor using averaged velocity derivatives
20226 !! and cylindrical geometric factors, then updates `flux_src_vf`.
20227 !! Assumes x-dir is axial (z_cyl), y-dir is radial (r_cyl), z-dir is azimuthal (theta_cyl for derivatives).
20228 !! @param[in] velL_vf Left boundary velocity (\f$v_x, v_y, v_z\f$) (num_dims scalar_field).
20229 !! @param[in] dvelL_dx_vf Left boundary \f$\partial v_i/\partial x\f$ (num_dims scalar_field).
20230 !! @param[in] dvelL_dy_vf Left boundary \f$\partial v_i/\partial y\f$ (num_dims scalar_field).
20231 !! @param[in] dvelL_dz_vf Left boundary \f$\partial v_i/\partial z\f$ (num_dims scalar_field).
20232 !! @param[in] velR_vf Right boundary velocity (\f$v_x, v_y, v_z\f$) (num_dims scalar_field).
20233 !! @param[in] dvelR_dx_vf Right boundary \f$\partial v_i/\partial x\f$ (num_dims scalar_field).
20234 !! @param[in] dvelR_dy_vf Right boundary \f$\partial v_i/\partial y\f$ (num_dims scalar_field).
20235 !! @param[in] dvelR_dz_vf Right boundary \f$\partial v_i/\partial z\f$ (num_dims scalar_field).
20236 !! @param[inout] flux_src_vf Intercell source flux array to update (sys_size scalar_field).
20237 !! @param[in] norm_dir Interface normal direction (1=x-face, 2=y-face, 3=z-face).
20238 !! @param[in] ix Global X-direction loop bounds (int_bounds_info).
20239 !! @param[in] iy Global Y-direction loop bounds (int_bounds_info).
20240 !! @param[in] iz Global Z-direction loop bounds (int_bounds_info).
20241 subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, &
20242 dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, &
20243 velR_vf, &
20244 dvelR_dx_vf, dvelR_dy_vf, dvelR_dz_vf, &
20245 flux_src_vf, norm_dir, ix, iy, iz)
20246
20247 type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
20248 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
20249 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
20250 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
20251 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
20252 integer, intent(in) :: norm_dir
20253 type(int_bounds_info), intent(in) :: ix, iy, iz
20254
20255 ! Local variables
20256# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20257 real(wp), dimension(num_dims) :: avg_v_int !!< Averaged interface velocity (\f$v_x, v_y, v_z\f$) (grid directions).
20258 real(wp), dimension(num_dims) :: avg_dvdx_int !!< Averaged interface \f$\partial v_i/\partial x\f$ (grid dir 1).
20259 real(wp), dimension(num_dims) :: avg_dvdy_int !!< Averaged interface \f$\partial v_i/\partial y\f$ (grid dir 2).
20260 real(wp), dimension(num_dims) :: avg_dvdz_int !!< Averaged interface \f$\partial v_i/\partial z\f$ (grid dir 3).
20261 real(wp), dimension(num_dims) :: vel_src_int !!< Interface velocity (\f$v_1,v_2,v_3\f$) (grid directions) for viscous work.
20262 real(wp), dimension(num_dims) :: stress_vector_shear !!< Shear stress vector (\f$\sigma_{N1}, \sigma_{N2}, \sigma_{N3}\f$) on N-face (grid directions).
20263# 4699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20264 real(wp) :: stress_normal_bulk !!< Normal bulk stress component \f$\sigma_{NN}\f$ on N-face.
20265
20266 real(wp) :: Re_s, Re_b !!< Effective interface shear and bulk Reynolds numbers.
20267 real(wp) :: r_eff !!< Effective radius at interface for cylindrical terms.
20268 real(wp) :: div_v_term_const !!< Common term \f$-(2/3)(\nabla \cdot \mathbf{v}) / \text{Re}_s\f$ for shear stress diagonal.
20269 real(wp) :: divergence_cyl !!< Full divergence \f$\nabla \cdot \mathbf{v}\f$ in cylindrical coordinates.
20270
20271 integer :: j, k, l !!< Loop iterators for \f$x, y, z\f$ grid directions.
20272 integer :: i_vel !!< Loop iterator for velocity components.
20273 integer :: idx_rp(3) !!< Indices \f$(j,k,l)\f$ of 'right' point for averaging.
20274
20275
20276# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20277
20278# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20279#if defined(MFC_OpenACC)
20280# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20281!$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)
20282# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20283#elif defined(MFC_OpenMP)
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
20290# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20291!$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)
20292# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20293#endif
20294# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20295
20296 do l = iz%beg, iz%end
20297 do k = iy%beg, iy%end
20298 do j = ix%beg, ix%end
20299
20300 ! Determine indices for the 'right' state for averaging across the interface
20301 idx_rp = [j, k, l]
20302 idx_rp(norm_dir) = idx_rp(norm_dir) + 1
20303
20304 ! Average velocities and their derivatives at the interface
20305 ! For cylindrical: x-dir ~ axial (z_cyl), y-dir ~ radial (r_cyl), z-dir ~ azimuthal (theta_cyl)
20306
20307# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20308#if defined(MFC_OpenACC)
20309# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20310!$acc loop seq
20311# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20312#elif defined(MFC_OpenMP)
20313# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20314
20315# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20316#endif
20317 do i_vel = 1, num_dims
20318 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)))
20319
20320 avg_dvdx_int(i_vel) = 0.5_wp*(dvell_dx_vf(i_vel)%sf(j, k, l) + &
20321 dvelr_dx_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
20322 if (num_dims > 1) then
20323 avg_dvdy_int(i_vel) = 0.5_wp*(dvell_dy_vf(i_vel)%sf(j, k, l) + &
20324 dvelr_dy_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
20325 else
20326 avg_dvdy_int(i_vel) = 0.0_wp
20327 end if
20328 if (num_dims > 2) then
20329 avg_dvdz_int(i_vel) = 0.5_wp*(dvell_dz_vf(i_vel)%sf(j, k, l) + &
20330 dvelr_dz_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
20331 else
20332 avg_dvdz_int(i_vel) = 0.0_wp
20333 end if
20334 end do
20335
20336 ! Get Re numbers and interface velocity for viscous work
20337 select case (norm_dir)
20338 case (1) ! x-face (axial face in z_cyl direction)
20339 re_s = re_avg_rsx_vf(j, k, l, 1)
20340 re_b = re_avg_rsx_vf(j, k, l, 2)
20341 vel_src_int = vel_src_rsx_vf(j, k, l, 1:num_dims)
20342 r_eff = y_cc(k)
20343 case (2) ! y-face (radial face in r_cyl direction)
20344 re_s = re_avg_rsy_vf(k, j, l, 1)
20345 re_b = re_avg_rsy_vf(k, j, l, 2)
20346 vel_src_int = vel_src_rsy_vf(k, j, l, 1:num_dims)
20347 r_eff = y_cb(k)
20348 case (3) ! z-face (azimuthal face in theta_cyl direction)
20349 re_s = re_avg_rsz_vf(l, k, j, 1)
20350 re_b = re_avg_rsz_vf(l, k, j, 2)
20351 vel_src_int = vel_src_rsz_vf(l, k, j, 1:num_dims)
20352 r_eff = y_cc(k)
20353 end select
20354
20355 ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl)
20356# 4762 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20357 divergence_cyl = avg_dvdx_int(1) + avg_dvdy_int(2) + avg_v_int(2)/r_eff
20358 if (num_dims > 2) then
20359# 4765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20360 divergence_cyl = divergence_cyl + avg_dvdz_int(3)/r_eff
20361# 4767 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20362 end if
20363# 4769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20364
20365 stress_vector_shear = 0.0_wp
20366 stress_normal_bulk = 0.0_wp
20367
20368 if (shear_stress) then
20369 div_v_term_const = -(2.0_wp/3.0_wp)*divergence_cyl/re_s
20370
20371 select case (norm_dir)
20372 case (1) ! X-face (axial normal, z_cyl)
20373 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
20374 if (num_dims > 1) then
20375# 4781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20376 stress_vector_shear(2) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
20377# 4783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20378 end if
20379 if (num_dims > 2) then
20380# 4786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20381 stress_vector_shear(3) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
20382# 4788 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20383 end if
20384 case (2) ! Y-face (radial normal, r_cyl)
20385 if (num_dims > 1) then
20386# 4792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20387 stress_vector_shear(1) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
20388 stress_vector_shear(2) = (2.0_wp*avg_dvdy_int(2))/re_s + div_v_term_const
20389 if (num_dims > 2) then
20390# 4796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20391 stress_vector_shear(3) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
20392# 4798 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20393 end if
20394# 4800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20395 else
20396 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
20397 end if
20398 case (3) ! Z-face (azimuthal normal, theta_cyl)
20399 if (num_dims > 2) then
20400# 4806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20401 stress_vector_shear(1) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
20402 stress_vector_shear(2) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
20403 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
20404# 4810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20405 end if
20406 end select
20407
20408
20409# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20410#if defined(MFC_OpenACC)
20411# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20412!$acc loop seq
20413# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20414#elif defined(MFC_OpenMP)
20415# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20416
20417# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20418#endif
20419 do i_vel = 1, num_dims
20420 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)
20421 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)
20422 end do
20423 end if
20424
20425 if (bulk_stress) then
20426 stress_normal_bulk = divergence_cyl/re_b
20427
20428 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
20429 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
20430 end if
20431
20432 end do
20433 end do
20434 end do
20435
20436# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20437
20438# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20439#if defined(MFC_OpenACC)
20440# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20441!$acc end parallel loop
20442# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20443#elif defined(MFC_OpenMP)
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
20448# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20449!$omp end target teams loop
20450# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20451#endif
20452# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20453
20454
20455 end subroutine s_compute_cylindrical_viscous_source_flux
20456
20457 !> @brief Computes Cartesian viscous source flux contributions for momentum and energy.
20458 !! Calculates averaged velocity gradients, gets Re and interface velocities,
20459 !! calls helpers for shear/bulk stress, then updates `flux_src_vf`.
20460 !! @param[in] dvelL_dx_vf Left boundary d(vel)/dx (num_dims scalar_field).
20461 !! @param[in] dvelL_dy_vf Left boundary d(vel)/dy (num_dims scalar_field).
20462 !! @param[in] dvelL_dz_vf Left boundary d(vel)/dz (num_dims scalar_field).
20463 !! @param[in] dvelR_dx_vf Right boundary d(vel)/dx (num_dims scalar_field).
20464 !! @param[in] dvelR_dy_vf Right boundary d(vel)/dy (num_dims scalar_field).
20465 !! @param[in] dvelR_dz_vf Right boundary d(vel)/dz (num_dims scalar_field).
20466 !! @param[inout] flux_src_vf Intercell source flux array to update (sys_size scalar_field).
20467 !! @param[in] norm_dir Interface normal direction (1=x, 2=y, 3=z).
20468 subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, &
20469 dvelL_dy_vf, &
20470 dvelL_dz_vf, &
20471 dvelR_dx_vf, &
20472 dvelR_dy_vf, &
20473 dvelR_dz_vf, &
20474 flux_src_vf, &
20475 norm_dir)
20476
20477 ! Arguments
20478 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
20479 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
20480 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
20481 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
20482 integer, intent(in) :: norm_dir
20483
20484 ! Local variables
20485# 4868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20486 real(wp), dimension(num_dims, num_dims) :: vel_grad_avg !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
20487 real(wp), dimension(num_dims, num_dims) :: current_tau_shear !< Current shear stress tensor.
20488 real(wp), dimension(num_dims, num_dims) :: current_tau_bulk !< Current bulk stress tensor.
20489 real(wp), dimension(num_dims) :: vel_src_at_interface !< Interface velocities (u,v,w) for viscous work.
20490# 4873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20491 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
20492
20493 real(wp) :: Re_shear !< Interface shear Reynolds number.
20494 real(wp) :: Re_bulk !< Interface bulk Reynolds number.
20495
20496 integer :: j_loop !< Physical x-index loop iterator.
20497 integer :: k_loop !< Physical y-index loop iterator.
20498 integer :: l_loop !< Physical z-index loop iterator.
20499 integer :: i_dim !< Generic dimension/component iterator.
20500 integer :: vel_comp_idx !< Velocity component iterator (1=u, 2=v, 3=w).
20501
20502 real(wp) :: divergence_v !< Velocity divergence at interface.
20503
20504
20505# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20506
20507# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20508#if defined(MFC_OpenACC)
20509# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20510!$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)
20511# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20512#elif defined(MFC_OpenMP)
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
20519# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20520!$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)
20521# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20522#endif
20523# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20524
20525 do l_loop = isz%beg, isz%end
20526 do k_loop = isy%beg, isy%end
20527 do j_loop = isx%beg, isx%end
20528
20529 idx_right_phys(1) = j_loop
20530 idx_right_phys(2) = k_loop
20531 idx_right_phys(3) = l_loop
20532 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
20533
20534 vel_grad_avg = 0.0_wp
20535 do vel_comp_idx = 1, num_dims
20536 vel_grad_avg(vel_comp_idx, 1) = 0.5_wp*(dvell_dx_vf(vel_comp_idx)%sf(j_loop, k_loop, l_loop) + &
20537 dvelr_dx_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3)))
20538 if (num_dims > 1) then
20539# 4902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20540 vel_grad_avg(vel_comp_idx, 2) = 0.5_wp*(dvell_dy_vf(vel_comp_idx)%sf(j_loop, k_loop, l_loop) + &
20541 dvelr_dy_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3)))
20542# 4905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20543 end if
20544 if (num_dims > 2) then
20545# 4908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20546 vel_grad_avg(vel_comp_idx, 3) = 0.5_wp*(dvell_dz_vf(vel_comp_idx)%sf(j_loop, k_loop, l_loop) + &
20547 dvelr_dz_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3)))
20548# 4911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20549 end if
20550 end do
20551
20552 divergence_v = 0.0_wp
20553 do i_dim = 1, num_dims
20554 divergence_v = divergence_v + vel_grad_avg(i_dim, i_dim)
20555 end do
20556
20557 vel_src_at_interface = 0.0_wp
20558 if (norm_dir == 1) then
20559 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
20560 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
20561 do i_dim = 1, num_dims
20562 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
20563 end do
20564 else if (norm_dir == 2) then
20565 re_shear = re_avg_rsy_vf(k_loop, j_loop, l_loop, 1)
20566 re_bulk = re_avg_rsy_vf(k_loop, j_loop, l_loop, 2)
20567 do i_dim = 1, num_dims
20568 vel_src_at_interface(i_dim) = vel_src_rsy_vf(k_loop, j_loop, l_loop, i_dim)
20569 end do
20570 else
20571 re_shear = re_avg_rsz_vf(l_loop, k_loop, j_loop, 1)
20572 re_bulk = re_avg_rsz_vf(l_loop, k_loop, j_loop, 2)
20573 do i_dim = 1, num_dims
20574 vel_src_at_interface(i_dim) = vel_src_rsz_vf(l_loop, k_loop, j_loop, i_dim)
20575 end do
20576 end if
20577
20578 if (shear_stress) then
20579 ! current_tau_shear = 0.0_wp
20580 call s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, current_tau_shear)
20581
20582 do i_dim = 1, num_dims
20583 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = &
20584 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) - current_tau_shear(norm_dir, i_dim)
20585
20586 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) = &
20587 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) - &
20588 vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
20589 end do
20590 end if
20591
20592 if (bulk_stress) then
20593 ! current_tau_bulk = 0.0_wp
20594 call s_calculate_bulk_stress_tensor(re_bulk, divergence_v, current_tau_bulk)
20595
20596 do i_dim = 1, num_dims
20597 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = &
20598 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) - current_tau_bulk(norm_dir, i_dim)
20599
20600 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) = &
20601 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) - &
20602 vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
20603 end do
20604 end if
20605
20606 end do
20607 end do
20608 end do
20609
20610# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20611
20612# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20613#if defined(MFC_OpenACC)
20614# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20615!$acc end parallel loop
20616# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20617#elif defined(MFC_OpenMP)
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
20622# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20623!$omp end target teams loop
20624# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20625#endif
20626# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20627
20628
20629 end subroutine s_compute_cartesian_viscous_source_flux
20630
20631 !> @brief Calculates shear stress tensor components.
20632 !! tau_ij_shear = ( (dui/dxj + duj/dxi) - (2/3)*(div_v)*delta_ij ) / Re_shear
20633 !! @param[in] vel_grad_avg Averaged velocity gradient tensor (d(vel_i)/d(coord_j)).
20634 !! @param[in] Re_shear Shear Reynolds number.
20635 !! @param[in] divergence_v Velocity divergence (du/dx + dv/dy + dw/dz).
20636 !! @param[out] tau_shear_out Calculated shear stress tensor (stress on i-face, j-direction).
20637 subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out)
20638
20639# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20640#if MFC_OpenACC
20641# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20642!$acc routine seq
20643# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20644#elif MFC_OpenMP
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
20649# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20650!$omp declare target device_type(any)
20651# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20652#endif
20653
20654 ! Arguments
20655# 4989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20656 real(wp), dimension(num_dims, num_dims), intent(in) :: vel_grad_avg
20657 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_shear_out
20658# 4992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20659 real(wp), intent(in) :: Re_shear
20660 real(wp), intent(in) :: divergence_v
20661
20662 ! Local variables
20663 integer :: i_dim !< Loop iterator for face normal.
20664 integer :: j_dim !< Loop iterator for force component direction.
20665
20666 tau_shear_out = 0.0_wp
20667
20668 do i_dim = 1, num_dims
20669 do j_dim = 1, num_dims
20670 tau_shear_out(i_dim, j_dim) = (vel_grad_avg(j_dim, i_dim) + vel_grad_avg(i_dim, j_dim))/re_shear
20671 if (i_dim == j_dim) then
20672 tau_shear_out(i_dim, j_dim) = tau_shear_out(i_dim, j_dim) - &
20673 (2.0_wp/3.0_wp)*divergence_v/re_shear
20674 end if
20675 end do
20676 end do
20677
20678 end subroutine s_calculate_shear_stress_tensor
20679
20680 !> @brief Calculates bulk stress tensor components (diagonal only).
20681 !! tau_ii_bulk = (div_v) / Re_bulk. Off-diagonals are zero.
20682 !! @param[in] Re_bulk Bulk Reynolds number.
20683 !! @param[in] divergence_v Velocity divergence (du/dx + dv/dy + dw/dz).
20684 !! @param[out] tau_bulk_out Calculated bulk stress tensor (stress on i-face, i-direction).
20685 subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out)
20686
20687# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20688#if MFC_OpenACC
20689# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20690!$acc routine seq
20691# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20692#elif MFC_OpenMP
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
20697# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20698!$omp declare target device_type(any)
20699# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20700#endif
20701
20702 ! Arguments
20703 real(wp), intent(in) :: Re_bulk
20704 real(wp), intent(in) :: divergence_v
20705# 5027 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20706 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_bulk_out
20707# 5029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20708
20709 ! Local variables
20710 integer :: i_dim !< Loop iterator for diagonal components.
20711
20712 tau_bulk_out = 0.0_wp
20713
20714 do i_dim = 1, num_dims
20715 tau_bulk_out(i_dim, i_dim) = divergence_v/re_bulk
20716 end do
20717
20718 end subroutine s_calculate_bulk_stress_tensor
20719
20720 !> Deallocation and/or disassociation procedures that are
20721 !! needed to finalize the selected Riemann problem solver
20722 !! @param flux_vf Intercell fluxes
20723 !! @param flux_src_vf Intercell source fluxes
20724 !! @param flux_gsrc_vf Intercell geometric source fluxes
20725 !! @param norm_dir Dimensional splitting coordinate direction
20726 subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, &
20727 flux_gsrc_vf, &
20728 norm_dir)
20729
20730 type(scalar_field), &
20731 dimension(sys_size), &
20732 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
20733
20734 integer, intent(in) :: norm_dir
20735
20736 integer :: i, j, k, l !< Generic loop iterators
20737
20738 ! Reshaping Outputted Data in y-direction
20739 if (norm_dir == 2) then
20740
20741# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20742
20743# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20744#if defined(MFC_OpenACC)
20745# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20746!$acc parallel loop collapse(4) gang vector default(present)
20747# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20748#elif defined(MFC_OpenMP)
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
20755# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20756!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20757# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20758#endif
20759# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20760
20761 do i = 1, sys_size
20762 do l = is3%beg, is3%end
20763 do j = is1%beg, is1%end
20764 do k = is2%beg, is2%end
20765 flux_vf(i)%sf(k, j, l) = &
20766 flux_rsy_vf(j, k, l, i)
20767 end do
20768 end do
20769 end do
20770 end do
20771
20772# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20773
20774# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20775#if defined(MFC_OpenACC)
20776# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20777!$acc end parallel loop
20778# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20779#elif defined(MFC_OpenMP)
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
20784# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20785!$omp end target teams loop
20786# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20787#endif
20788# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20789
20790
20791 if (cyl_coord) then
20792
20793# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20794
20795# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20796#if defined(MFC_OpenACC)
20797# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20798!$acc parallel loop collapse(4) gang vector default(present)
20799# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20800#elif defined(MFC_OpenMP)
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
20807# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20808!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20809# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20810#endif
20811# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20812
20813 do i = 1, sys_size
20814 do l = is3%beg, is3%end
20815 do j = is1%beg, is1%end
20816 do k = is2%beg, is2%end
20817 flux_gsrc_vf(i)%sf(k, j, l) = &
20818 flux_gsrc_rsy_vf(j, k, l, i)
20819 end do
20820 end do
20821 end do
20822 end do
20823
20824# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20825
20826# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20827#if defined(MFC_OpenACC)
20828# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20829!$acc end parallel loop
20830# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20831#elif defined(MFC_OpenMP)
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
20836# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20837!$omp end target teams loop
20838# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20839#endif
20840# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20841
20842 end if
20843
20844
20845# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20846
20847# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20848#if defined(MFC_OpenACC)
20849# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20850!$acc parallel loop collapse(3) gang vector default(present)
20851# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20852#elif defined(MFC_OpenMP)
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
20859# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20860!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20861# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20862#endif
20863# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20864
20865 do l = is3%beg, is3%end
20866 do j = is1%beg, is1%end
20867 do k = is2%beg, is2%end
20868 flux_src_vf(advxb)%sf(k, j, l) = &
20869 flux_src_rsy_vf(j, k, l, advxb)
20870 end do
20871 end do
20872 end do
20873
20874# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20875
20876# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20877#if defined(MFC_OpenACC)
20878# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20879!$acc end parallel loop
20880# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20881#elif defined(MFC_OpenMP)
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
20886# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20887!$omp end target teams loop
20888# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20889#endif
20890# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20891
20892
20893 if (riemann_solver == 1 .or. riemann_solver == 4) then
20894
20895# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20896
20897# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20898#if defined(MFC_OpenACC)
20899# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20900!$acc parallel loop collapse(4) gang vector default(present)
20901# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20902#elif defined(MFC_OpenMP)
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
20909# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20910!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20911# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20912#endif
20913# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20914
20915 do i = advxb + 1, advxe
20916 do l = is3%beg, is3%end
20917 do j = is1%beg, is1%end
20918 do k = is2%beg, is2%end
20919 flux_src_vf(i)%sf(k, j, l) = &
20920 flux_src_rsy_vf(j, k, l, i)
20921 end do
20922 end do
20923 end do
20924 end do
20925
20926# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20927
20928# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20929#if defined(MFC_OpenACC)
20930# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20931!$acc end parallel loop
20932# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20933#elif defined(MFC_OpenMP)
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
20938# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20939!$omp end target teams loop
20940# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20941#endif
20942# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20943
20944
20945 end if
20946 ! Reshaping Outputted Data in z-direction
20947 elseif (norm_dir == 3) then
20948
20949# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20950
20951# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20952#if defined(MFC_OpenACC)
20953# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20954!$acc parallel loop collapse(4) gang vector default(present)
20955# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20956#elif defined(MFC_OpenMP)
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
20963# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20964!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20965# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20966#endif
20967# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20968
20969 do i = 1, sys_size
20970 do j = is1%beg, is1%end
20971 do k = is2%beg, is2%end
20972 do l = is3%beg, is3%end
20973
20974 flux_vf(i)%sf(l, k, j) = &
20975 flux_rsz_vf(j, k, l, i)
20976 end do
20977 end do
20978 end do
20979 end do
20980
20981# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20982
20983# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20984#if defined(MFC_OpenACC)
20985# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20986!$acc end parallel loop
20987# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20988#elif defined(MFC_OpenMP)
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
20993# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20994!$omp end target teams loop
20995# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20996#endif
20997# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20998
20999 if (grid_geometry == 3) then
21000
21001# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21002
21003# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21004#if defined(MFC_OpenACC)
21005# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21006!$acc parallel loop collapse(4) gang vector default(present)
21007# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21008#elif defined(MFC_OpenMP)
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
21015# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21016!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21017# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21018#endif
21019# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21020
21021 do i = 1, sys_size
21022 do j = is1%beg, is1%end
21023 do k = is2%beg, is2%end
21024 do l = is3%beg, is3%end
21025
21026 flux_gsrc_vf(i)%sf(l, k, j) = &
21027 flux_gsrc_rsz_vf(j, k, l, i)
21028 end do
21029 end do
21030 end do
21031 end do
21032
21033# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21034
21035# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21036#if defined(MFC_OpenACC)
21037# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21038!$acc end parallel loop
21039# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21040#elif defined(MFC_OpenMP)
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
21045# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21046!$omp end target teams loop
21047# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21048#endif
21049# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21050
21051 end if
21052
21053
21054# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21055
21056# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21057#if defined(MFC_OpenACC)
21058# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21059!$acc parallel loop collapse(3) gang vector default(present)
21060# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21061#elif defined(MFC_OpenMP)
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
21068# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21069!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21070# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21071#endif
21072# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21073
21074 do j = is1%beg, is1%end
21075 do k = is2%beg, is2%end
21076 do l = is3%beg, is3%end
21077 flux_src_vf(advxb)%sf(l, k, j) = &
21078 flux_src_rsz_vf(j, k, l, advxb)
21079 end do
21080 end do
21081 end do
21082
21083# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21084
21085# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21086#if defined(MFC_OpenACC)
21087# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21088!$acc end parallel loop
21089# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21090#elif defined(MFC_OpenMP)
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
21095# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21096!$omp end target teams loop
21097# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21098#endif
21099# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21100
21101
21102 if (riemann_solver == 1 .or. riemann_solver == 4) then
21103
21104# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21105
21106# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21107#if defined(MFC_OpenACC)
21108# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21109!$acc parallel loop collapse(4) gang vector default(present)
21110# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21111#elif defined(MFC_OpenMP)
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
21118# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21119!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21120# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21121#endif
21122# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21123
21124 do i = advxb + 1, advxe
21125 do j = is1%beg, is1%end
21126 do k = is2%beg, is2%end
21127 do l = is3%beg, is3%end
21128 flux_src_vf(i)%sf(l, k, j) = &
21129 flux_src_rsz_vf(j, k, l, i)
21130 end do
21131 end do
21132 end do
21133 end do
21134
21135# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21136
21137# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21138#if defined(MFC_OpenACC)
21139# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21140!$acc end parallel loop
21141# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21142#elif defined(MFC_OpenMP)
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
21147# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21148!$omp end target teams loop
21149# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21150#endif
21151# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21152
21153
21154 end if
21155 elseif (norm_dir == 1) then
21156
21157# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21158
21159# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21160#if defined(MFC_OpenACC)
21161# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21162!$acc parallel loop collapse(4) gang vector default(present)
21163# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21164#elif defined(MFC_OpenMP)
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
21171# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21172!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21173# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21174#endif
21175# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21176
21177 do i = 1, sys_size
21178 do l = is3%beg, is3%end
21179 do k = is2%beg, is2%end
21180 do j = is1%beg, is1%end
21181 flux_vf(i)%sf(j, k, l) = &
21182 flux_rsx_vf(j, k, l, i)
21183 end do
21184 end do
21185 end do
21186 end do
21187
21188# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21189
21190# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21191#if defined(MFC_OpenACC)
21192# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21193!$acc end parallel loop
21194# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21195#elif defined(MFC_OpenMP)
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
21200# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21201!$omp end target teams loop
21202# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21203#endif
21204# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21205
21206
21207
21208# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21209
21210# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21211#if defined(MFC_OpenACC)
21212# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21213!$acc parallel loop collapse(3) gang vector default(present)
21214# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21215#elif defined(MFC_OpenMP)
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
21222# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21223!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21224# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21225#endif
21226# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21227
21228 do l = is3%beg, is3%end
21229 do k = is2%beg, is2%end
21230 do j = is1%beg, is1%end
21231 flux_src_vf(advxb)%sf(j, k, l) = &
21232 flux_src_rsx_vf(j, k, l, advxb)
21233 end do
21234 end do
21235 end do
21236
21237# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21238
21239# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21240#if defined(MFC_OpenACC)
21241# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21242!$acc end parallel loop
21243# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21244#elif defined(MFC_OpenMP)
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
21249# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21250!$omp end target teams loop
21251# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21252#endif
21253# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21254
21255
21256 if (riemann_solver == 1 .or. riemann_solver == 4) then
21257
21258# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21259
21260# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21261#if defined(MFC_OpenACC)
21262# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21263!$acc parallel loop collapse(4) gang vector default(present)
21264# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21265#elif defined(MFC_OpenMP)
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
21272# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21273!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21274# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21275#endif
21276# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21277
21278 do i = advxb + 1, advxe
21279 do l = is3%beg, is3%end
21280 do k = is2%beg, is2%end
21281 do j = is1%beg, is1%end
21282 flux_src_vf(i)%sf(j, k, l) = &
21283 flux_src_rsx_vf(j, k, l, i)
21284 end do
21285 end do
21286 end do
21287 end do
21288
21289# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21290
21291# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21292#if defined(MFC_OpenACC)
21293# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21294!$acc end parallel loop
21295# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21296#elif defined(MFC_OpenMP)
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
21301# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21302!$omp end target teams loop
21303# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21304#endif
21305# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21306
21307 end if
21308 end if
21309
21310 end subroutine s_finalize_riemann_solver
21311
21312 !> Module deallocation and/or disassociation procedures
21313 impure subroutine s_finalize_riemann_solvers_module
21314
21315 if (viscous) then
21316#ifdef MFC_DEBUG
21317# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21318 block
21319# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21320 use iso_fortran_env, only: output_unit
21321# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21322
21323# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21324 print *, 'm_riemann_solvers.fpp:5219: ', '@:DEALLOCATE(Re_avg_rsx_vf)'
21325# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21326
21327# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21328 call flush (output_unit)
21329# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21330 end block
21331# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21332#endif
21333# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21334
21335# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21336#if defined(MFC_OpenACC)
21337# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21338!$acc exit data delete(Re_avg_rsx_vf)
21339# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21340#elif defined(MFC_OpenMP)
21341# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21342!$omp target exit data map(release:Re_avg_rsx_vf)
21343# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21344#endif
21345# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21346 deallocate (re_avg_rsx_vf)
21347 end if
21348#ifdef MFC_DEBUG
21349# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21350 block
21351# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21352 use iso_fortran_env, only: output_unit
21353# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21354
21355# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21356 print *, 'm_riemann_solvers.fpp:5221: ', '@:DEALLOCATE(vel_src_rsx_vf)'
21357# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21358
21359# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21360 call flush (output_unit)
21361# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21362 end block
21363# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21364#endif
21365# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21366
21367# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21368#if defined(MFC_OpenACC)
21369# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21370!$acc exit data delete(vel_src_rsx_vf)
21371# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21372#elif defined(MFC_OpenMP)
21373# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21374!$omp target exit data map(release:vel_src_rsx_vf)
21375# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21376#endif
21377# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21378 deallocate (vel_src_rsx_vf)
21379#ifdef MFC_DEBUG
21380# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21381 block
21382# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21383 use iso_fortran_env, only: output_unit
21384# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21385
21386# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21387 print *, 'm_riemann_solvers.fpp:5222: ', '@:DEALLOCATE(flux_rsx_vf)'
21388# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21389
21390# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21391 call flush (output_unit)
21392# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21393 end block
21394# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21395#endif
21396# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21397
21398# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21399#if defined(MFC_OpenACC)
21400# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21401!$acc exit data delete(flux_rsx_vf)
21402# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21403#elif defined(MFC_OpenMP)
21404# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21405!$omp target exit data map(release:flux_rsx_vf)
21406# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21407#endif
21408# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21409 deallocate (flux_rsx_vf)
21410#ifdef MFC_DEBUG
21411# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21412 block
21413# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21414 use iso_fortran_env, only: output_unit
21415# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21416
21417# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21418 print *, 'm_riemann_solvers.fpp:5223: ', '@:DEALLOCATE(flux_src_rsx_vf)'
21419# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21420
21421# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21422 call flush (output_unit)
21423# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21424 end block
21425# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21426#endif
21427# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21428
21429# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21430#if defined(MFC_OpenACC)
21431# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21432!$acc exit data delete(flux_src_rsx_vf)
21433# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21434#elif defined(MFC_OpenMP)
21435# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21436!$omp target exit data map(release:flux_src_rsx_vf)
21437# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21438#endif
21439# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21440 deallocate (flux_src_rsx_vf)
21441#ifdef MFC_DEBUG
21442# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21443 block
21444# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21445 use iso_fortran_env, only: output_unit
21446# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21447
21448# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21449 print *, 'm_riemann_solvers.fpp:5224: ', '@:DEALLOCATE(flux_gsrc_rsx_vf)'
21450# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21451
21452# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21453 call flush (output_unit)
21454# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21455 end block
21456# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21457#endif
21458# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21459
21460# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21461#if defined(MFC_OpenACC)
21462# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21463!$acc exit data delete(flux_gsrc_rsx_vf)
21464# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21465#elif defined(MFC_OpenMP)
21466# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21467!$omp target exit data map(release:flux_gsrc_rsx_vf)
21468# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21469#endif
21470# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21471 deallocate (flux_gsrc_rsx_vf)
21472 if (qbmm) then
21473#ifdef MFC_DEBUG
21474# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21475 block
21476# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21477 use iso_fortran_env, only: output_unit
21478# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21479
21480# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21481 print *, 'm_riemann_solvers.fpp:5226: ', '@:DEALLOCATE(mom_sp_rsx_vf)'
21482# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21483
21484# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21485 call flush (output_unit)
21486# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21487 end block
21488# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21489#endif
21490# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21491
21492# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21493#if defined(MFC_OpenACC)
21494# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21495!$acc exit data delete(mom_sp_rsx_vf)
21496# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21497#elif defined(MFC_OpenMP)
21498# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21499!$omp target exit data map(release:mom_sp_rsx_vf)
21500# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21501#endif
21502# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21503 deallocate (mom_sp_rsx_vf)
21504 end if
21505
21506 if (n == 0) return
21507
21508 if (viscous) then
21509#ifdef MFC_DEBUG
21510# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21511 block
21512# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21513 use iso_fortran_env, only: output_unit
21514# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21515
21516# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21517 print *, 'm_riemann_solvers.fpp:5232: ', '@:DEALLOCATE(Re_avg_rsy_vf)'
21518# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21519
21520# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21521 call flush (output_unit)
21522# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21523 end block
21524# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21525#endif
21526# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21527
21528# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21529#if defined(MFC_OpenACC)
21530# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21531!$acc exit data delete(Re_avg_rsy_vf)
21532# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21533#elif defined(MFC_OpenMP)
21534# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21535!$omp target exit data map(release:Re_avg_rsy_vf)
21536# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21537#endif
21538# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21539 deallocate (re_avg_rsy_vf)
21540 end if
21541#ifdef MFC_DEBUG
21542# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21543 block
21544# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21545 use iso_fortran_env, only: output_unit
21546# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21547
21548# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21549 print *, 'm_riemann_solvers.fpp:5234: ', '@:DEALLOCATE(vel_src_rsy_vf)'
21550# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21551
21552# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21553 call flush (output_unit)
21554# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21555 end block
21556# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21557#endif
21558# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21559
21560# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21561#if defined(MFC_OpenACC)
21562# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21563!$acc exit data delete(vel_src_rsy_vf)
21564# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21565#elif defined(MFC_OpenMP)
21566# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21567!$omp target exit data map(release:vel_src_rsy_vf)
21568# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21569#endif
21570# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21571 deallocate (vel_src_rsy_vf)
21572#ifdef MFC_DEBUG
21573# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21574 block
21575# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21576 use iso_fortran_env, only: output_unit
21577# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21578
21579# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21580 print *, 'm_riemann_solvers.fpp:5235: ', '@:DEALLOCATE(flux_rsy_vf)'
21581# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21582
21583# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21584 call flush (output_unit)
21585# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21586 end block
21587# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21588#endif
21589# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21590
21591# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21592#if defined(MFC_OpenACC)
21593# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21594!$acc exit data delete(flux_rsy_vf)
21595# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21596#elif defined(MFC_OpenMP)
21597# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21598!$omp target exit data map(release:flux_rsy_vf)
21599# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21600#endif
21601# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21602 deallocate (flux_rsy_vf)
21603#ifdef MFC_DEBUG
21604# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21605 block
21606# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21607 use iso_fortran_env, only: output_unit
21608# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21609
21610# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21611 print *, 'm_riemann_solvers.fpp:5236: ', '@:DEALLOCATE(flux_src_rsy_vf)'
21612# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21613
21614# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21615 call flush (output_unit)
21616# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21617 end block
21618# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21619#endif
21620# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21621
21622# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21623#if defined(MFC_OpenACC)
21624# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21625!$acc exit data delete(flux_src_rsy_vf)
21626# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21627#elif defined(MFC_OpenMP)
21628# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21629!$omp target exit data map(release:flux_src_rsy_vf)
21630# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21631#endif
21632# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21633 deallocate (flux_src_rsy_vf)
21634#ifdef MFC_DEBUG
21635# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21636 block
21637# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21638 use iso_fortran_env, only: output_unit
21639# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21640
21641# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21642 print *, 'm_riemann_solvers.fpp:5237: ', '@:DEALLOCATE(flux_gsrc_rsy_vf)'
21643# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21644
21645# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21646 call flush (output_unit)
21647# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21648 end block
21649# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21650#endif
21651# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21652
21653# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21654#if defined(MFC_OpenACC)
21655# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21656!$acc exit data delete(flux_gsrc_rsy_vf)
21657# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21658#elif defined(MFC_OpenMP)
21659# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21660!$omp target exit data map(release:flux_gsrc_rsy_vf)
21661# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21662#endif
21663# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21664 deallocate (flux_gsrc_rsy_vf)
21665 if (qbmm) then
21666#ifdef MFC_DEBUG
21667# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21668 block
21669# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21670 use iso_fortran_env, only: output_unit
21671# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21672
21673# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21674 print *, 'm_riemann_solvers.fpp:5239: ', '@:DEALLOCATE(mom_sp_rsy_vf)'
21675# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21676
21677# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21678 call flush (output_unit)
21679# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21680 end block
21681# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21682#endif
21683# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21684
21685# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21686#if defined(MFC_OpenACC)
21687# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21688!$acc exit data delete(mom_sp_rsy_vf)
21689# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21690#elif defined(MFC_OpenMP)
21691# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21692!$omp target exit data map(release:mom_sp_rsy_vf)
21693# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21694#endif
21695# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21696 deallocate (mom_sp_rsy_vf)
21697 end if
21698
21699 if (p == 0) return
21700
21701 if (viscous) then
21702#ifdef MFC_DEBUG
21703# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21704 block
21705# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21706 use iso_fortran_env, only: output_unit
21707# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21708
21709# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21710 print *, 'm_riemann_solvers.fpp:5245: ', '@:DEALLOCATE(Re_avg_rsz_vf)'
21711# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21712
21713# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21714 call flush (output_unit)
21715# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21716 end block
21717# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21718#endif
21719# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21720
21721# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21722#if defined(MFC_OpenACC)
21723# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21724!$acc exit data delete(Re_avg_rsz_vf)
21725# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21726#elif defined(MFC_OpenMP)
21727# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21728!$omp target exit data map(release:Re_avg_rsz_vf)
21729# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21730#endif
21731# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21732 deallocate (re_avg_rsz_vf)
21733 end if
21734#ifdef MFC_DEBUG
21735# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21736 block
21737# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21738 use iso_fortran_env, only: output_unit
21739# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21740
21741# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21742 print *, 'm_riemann_solvers.fpp:5247: ', '@:DEALLOCATE(vel_src_rsz_vf)'
21743# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21744
21745# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21746 call flush (output_unit)
21747# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21748 end block
21749# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21750#endif
21751# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21752
21753# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21754#if defined(MFC_OpenACC)
21755# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21756!$acc exit data delete(vel_src_rsz_vf)
21757# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21758#elif defined(MFC_OpenMP)
21759# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21760!$omp target exit data map(release:vel_src_rsz_vf)
21761# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21762#endif
21763# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21764 deallocate (vel_src_rsz_vf)
21765#ifdef MFC_DEBUG
21766# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21767 block
21768# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21769 use iso_fortran_env, only: output_unit
21770# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21771
21772# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21773 print *, 'm_riemann_solvers.fpp:5248: ', '@:DEALLOCATE(flux_rsz_vf)'
21774# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21775
21776# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21777 call flush (output_unit)
21778# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21779 end block
21780# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21781#endif
21782# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21783
21784# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21785#if defined(MFC_OpenACC)
21786# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21787!$acc exit data delete(flux_rsz_vf)
21788# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21789#elif defined(MFC_OpenMP)
21790# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21791!$omp target exit data map(release:flux_rsz_vf)
21792# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21793#endif
21794# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21795 deallocate (flux_rsz_vf)
21796#ifdef MFC_DEBUG
21797# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21798 block
21799# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21800 use iso_fortran_env, only: output_unit
21801# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21802
21803# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21804 print *, 'm_riemann_solvers.fpp:5249: ', '@:DEALLOCATE(flux_src_rsz_vf)'
21805# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21806
21807# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21808 call flush (output_unit)
21809# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21810 end block
21811# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21812#endif
21813# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21814
21815# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21816#if defined(MFC_OpenACC)
21817# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21818!$acc exit data delete(flux_src_rsz_vf)
21819# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21820#elif defined(MFC_OpenMP)
21821# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21822!$omp target exit data map(release:flux_src_rsz_vf)
21823# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21824#endif
21825# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21826 deallocate (flux_src_rsz_vf)
21827#ifdef MFC_DEBUG
21828# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21829 block
21830# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21831 use iso_fortran_env, only: output_unit
21832# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21833
21834# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21835 print *, 'm_riemann_solvers.fpp:5250: ', '@:DEALLOCATE(flux_gsrc_rsz_vf)'
21836# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21837
21838# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21839 call flush (output_unit)
21840# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21841 end block
21842# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21843#endif
21844# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21845
21846# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21847#if defined(MFC_OpenACC)
21848# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21849!$acc exit data delete(flux_gsrc_rsz_vf)
21850# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21851#elif defined(MFC_OpenMP)
21852# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21853!$omp target exit data map(release:flux_gsrc_rsz_vf)
21854# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21855#endif
21856# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21857 deallocate (flux_gsrc_rsz_vf)
21858 if (qbmm) then
21859#ifdef MFC_DEBUG
21860# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21861 block
21862# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21863 use iso_fortran_env, only: output_unit
21864# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21865
21866# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21867 print *, 'm_riemann_solvers.fpp:5252: ', '@:DEALLOCATE(mom_sp_rsz_vf)'
21868# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21869
21870# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21871 call flush (output_unit)
21872# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21873 end block
21874# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21875#endif
21876# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21877
21878# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21879#if defined(MFC_OpenACC)
21880# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21881!$acc exit data delete(mom_sp_rsz_vf)
21882# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21883#elif defined(MFC_OpenMP)
21884# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21885!$omp target exit data map(release:mom_sp_rsz_vf)
21886# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21887#endif
21888# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21889 deallocate (mom_sp_rsz_vf)
21890 end if
21891
21892 end subroutine s_finalize_riemann_solvers_module
21893
21894end module m_riemann_solvers
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1182
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1182
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1182
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:294
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:335
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:335
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:335
m_bubbles
Shared bubble-dynamics procedures (radial acceleration, wall pressure, sound speed) for ensemble- and...
Definition m_bubbles.fpp.f90:294
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:669
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:306
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:350
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:294
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:305
m_global_parameters::bubbles_euler
logical bubbles_euler
Bubbles euler on/off.
Definition m_global_parameters.fpp.f90:1075
m_global_parameters::contxb
integer contxb
Definition m_global_parameters.fpp.f90:1303
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:859
m_global_parameters::bulk_stress
logical bulk_stress
Bulk stresses.
Definition m_global_parameters.fpp.f90:486
m_global_parameters::bubxb
integer bubxb
Definition m_global_parameters.fpp.f90:1305
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:347
m_global_parameters::wave_speeds
integer wave_speeds
Wave speeds estimation method.
Definition m_global_parameters.fpp.f90:472
m_global_parameters::cont_damage
logical cont_damage
Continuum damage modeling.
Definition m_global_parameters.fpp.f90:487
m_global_parameters::hypoelasticity
logical hypoelasticity
hypoelasticity modeling
Definition m_global_parameters.fpp.f90:477
m_global_parameters::avg_state
integer avg_state
Average state evaluation method.
Definition m_global_parameters.fpp.f90:473
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:484
m_global_parameters::xibeg
integer xibeg
Definition m_global_parameters.fpp.f90:1308
m_global_parameters::num_fluids
integer num_fluids
number of fluids in the simulation
Definition m_global_parameters.fpp.f90:440
m_global_parameters::momxe
integer momxe
Definition m_global_parameters.fpp.f90:1301
m_global_parameters::weno_re_flux
logical weno_re_flux
WENO reconstruct velocity gradients for viscous stress tensor.
Definition m_global_parameters.fpp.f90:469
m_global_parameters::hyper_cleaning_speed
real(wp) hyper_cleaning_speed
Hyperbolic cleaning wave speed (c_h).
Definition m_global_parameters.fpp.f90:1441
m_global_parameters::n_idx
integer n_idx
Index of number density.
Definition m_global_parameters.fpp.f90:773
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:1419
m_global_parameters::xiend
integer xiend
Definition m_global_parameters.fpp.f90:1308
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:769
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1061
m_global_parameters::advxe
integer advxe
Definition m_global_parameters.fpp.f90:1302
m_global_parameters::cyl_coord
logical cyl_coord
Definition m_global_parameters.fpp.f90:346
m_global_parameters::strxe
integer strxe
Definition m_global_parameters.fpp.f90:1306
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:902
m_global_parameters::chemxb
integer chemxb
Definition m_global_parameters.fpp.f90:1307
m_global_parameters::viscous
logical viscous
Viscous effects.
Definition m_global_parameters.fpp.f90:452
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:780
m_global_parameters::riemann_solver
integer riemann_solver
Riemann solver algorithm.
Definition m_global_parameters.fpp.f90:470
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:423
m_global_parameters::hyperelasticity
logical hyperelasticity
hyperelasticity modeling
Definition m_global_parameters.fpp.f90:478
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:961
m_global_parameters::chemxe
integer chemxe
Definition m_global_parameters.fpp.f90:1307
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
Definition m_global_parameters.fpp.f90:904
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:425
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:1062
m_global_parameters::chem_params
type(chemistry_parameters) chem_params
Definition m_global_parameters.fpp.f90:1183
m_global_parameters::num_vels
integer num_vels
Number of velocity components (different from num_dims for mhd).
Definition m_global_parameters.fpp.f90:426
m_global_parameters::polytropic
logical polytropic
Polytropic switch.
Definition m_global_parameters.fpp.f90:1076
m_global_parameters::re_idx
integer, dimension(:, :), allocatable re_idx
Definition m_global_parameters.fpp.f90:861
m_global_parameters::strxb
integer strxb
Definition m_global_parameters.fpp.f90:1306
m_global_parameters::qbmm
logical qbmm
Quadrature moment method.
Definition m_global_parameters.fpp.f90:1135
m_global_parameters::damage_idx
integer damage_idx
Index of damage state variable (D) for continuum damage model.
Definition m_global_parameters.fpp.f90:787
m_global_parameters::hyper_cleaning
logical hyper_cleaning
Hyperbolic cleaning for MHD for divB=0.
Definition m_global_parameters.fpp.f90:488
m_global_parameters::bx0
real(wp) bx0
Constant magnetic field in the x-direction (1D).
Definition m_global_parameters.fpp.f90:1405
m_global_parameters::contxe
integer contxe
Definition m_global_parameters.fpp.f90:1303
m_global_parameters::b_size
integer b_size
Number of elements in the symmetric b tensor, plus one.
Definition m_global_parameters.fpp.f90:783
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1354
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1354
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:1090
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:903
m_global_parameters::mhd
logical mhd
Magnetohydrodynamics.
Definition m_global_parameters.fpp.f90:446
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:937
m_global_parameters::e_idx
integer e_idx
Index of energy equation.
Definition m_global_parameters.fpp.f90:772
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:333
m_global_parameters::surface_tension
logical surface_tension
Definition m_global_parameters.fpp.f90:1287
m_global_parameters::intxb
integer intxb
Definition m_global_parameters.fpp.f90:1304
m_global_parameters::elasticity
logical elasticity
elasticity modeling, true for hyper or hypo
Definition m_global_parameters.fpp.f90:483
m_global_parameters::nb
integer nb
Number of eq. bubble sizes.
Definition m_global_parameters.fpp.f90:1042
m_global_parameters::c_idx
integer c_idx
Index of color function.
Definition m_global_parameters.fpp.f90:786
m_global_parameters::mpp_lim
logical mpp_lim
Mixture physical parameters (MPP) limits.
Definition m_global_parameters.fpp.f90:428
m_global_parameters::low_mach
integer low_mach
Low Mach number fix to HLLC Riemann solver.
Definition m_global_parameters.fpp.f90:471
m_global_parameters::psi_idx
integer psi_idx
Index of hyperbolic cleaning state variable for MHD.
Definition m_global_parameters.fpp.f90:788
m_global_parameters::shear_stress
logical shear_stress
Shear stresses.
Definition m_global_parameters.fpp.f90:485
m_global_parameters::relativity
logical relativity
Relativity (only for MHD).
Definition m_global_parameters.fpp.f90:447
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1354
m_global_parameters::intxe
integer intxe
Definition m_global_parameters.fpp.f90:1304
m_global_parameters::bubxe
integer bubxe
Definition m_global_parameters.fpp.f90:1305
m_global_parameters::alf_idx
integer alf_idx
Index of void fraction.
Definition m_global_parameters.fpp.f90:777
m_global_parameters::advxb
integer advxb
Definition m_global_parameters.fpp.f90:1302
m_global_parameters::momxb
integer momxb
Definition m_global_parameters.fpp.f90:1301
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:294
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:305
m_riemann_solvers
Approximate and exact Riemann solvers (HLL, HLLC, HLLD, exact) for the multicomponent Navier–Stokes e...
Definition m_riemann_solvers.fpp.f90:315
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:16816
m_riemann_solvers::is2
type(int_bounds_info) is2
Definition m_riemann_solvers.fpp.f90:446
m_riemann_solvers::flux_gsrc_rsx_vf
real(wp), dimension(:, :, :, :), allocatable flux_gsrc_rsx_vf
The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann ...
Definition m_riemann_solvers.fpp.f90:380
m_riemann_solvers::flux_gsrc_rsz_vf
real(wp), dimension(:, :, :, :), allocatable flux_gsrc_rsz_vf
Definition m_riemann_solvers.fpp.f90:382
m_riemann_solvers::mom_sp_rsx_vf
real(wp), dimension(:, :, :, :), allocatable mom_sp_rsx_vf
Definition m_riemann_solvers.fpp.f90:414
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:691
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:20246
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:20476
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:20686
m_riemann_solvers::vel_src_rsx_vf
real(wp), dimension(:, :, :, :), allocatable vel_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:399
m_riemann_solvers::is1
type(int_bounds_info) is1
Definition m_riemann_solvers.fpp.f90:446
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:18394
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:20729
m_riemann_solvers::mom_sp_rsy_vf
real(wp), dimension(:, :, :, :), allocatable mom_sp_rsy_vf
Definition m_riemann_solvers.fpp.f90:415
m_riemann_solvers::isx
type(int_bounds_info) isx
Definition m_riemann_solvers.fpp.f90:447
m_riemann_solvers::vel_src_rsz_vf
real(wp), dimension(:, :, :, :), allocatable vel_src_rsz_vf
Definition m_riemann_solvers.fpp.f90:401
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:21314
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:7153
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:20638
m_riemann_solvers::res_gs
real(wp), dimension(:, :), allocatable res_gs
Definition m_riemann_solvers.fpp.f90:475
m_riemann_solvers::mom_sp_rsz_vf
real(wp), dimension(:, :, :, :), allocatable mom_sp_rsz_vf
Definition m_riemann_solvers.fpp.f90:416
m_riemann_solvers::re_avg_rsx_vf
real(wp), dimension(:, :, :, :), allocatable re_avg_rsx_vf
Definition m_riemann_solvers.fpp.f90:429
m_riemann_solvers::is3
type(int_bounds_info) is3
Definition m_riemann_solvers.fpp.f90:446
m_riemann_solvers::flux_rsy_vf
real(wp), dimension(:, :, :, :), allocatable flux_rsy_vf
Definition m_riemann_solvers.fpp.f90:360
m_riemann_solvers::vel_src_rsy_vf
real(wp), dimension(:, :, :, :), allocatable vel_src_rsy_vf
Definition m_riemann_solvers.fpp.f90:400
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:4159
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:19726
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:359
m_riemann_solvers::flux_gsrc_rsy_vf
real(wp), dimension(:, :, :, :), allocatable flux_gsrc_rsy_vf
Definition m_riemann_solvers.fpp.f90:381
m_riemann_solvers::re_avg_rsz_vf
real(wp), dimension(:, :, :, :), allocatable re_avg_rsz_vf
Definition m_riemann_solvers.fpp.f90:431
m_riemann_solvers::re_avg_rsy_vf
real(wp), dimension(:, :, :, :), allocatable re_avg_rsy_vf
Definition m_riemann_solvers.fpp.f90:430
m_riemann_solvers::flux_src_rsy_vf
real(wp), dimension(:, :, :, :), allocatable flux_src_rsy_vf
Definition m_riemann_solvers.fpp.f90:360
m_riemann_solvers::flux_rsz_vf
real(wp), dimension(:, :, :, :), allocatable flux_rsz_vf
Definition m_riemann_solvers.fpp.f90:361
m_riemann_solvers::flux_src_rsx_vf
real(wp), dimension(:, :, :, :), allocatable flux_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:359
m_riemann_solvers::isy
type(int_bounds_info) isy
Definition m_riemann_solvers.fpp.f90:447
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:17595
m_riemann_solvers::flux_src_rsz_vf
real(wp), dimension(:, :, :, :), allocatable flux_src_rsz_vf
Definition m_riemann_solvers.fpp.f90:361
m_riemann_solvers::isz
type(int_bounds_info) isz
Definition m_riemann_solvers.fpp.f90:447
m_riemann_solvers::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_solvers.fpp.f90:462
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:638
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:538
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:308
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:721
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:305
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:2803
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:2711
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:383
m_derived_types::riemann_states_vec3
Left and right Riemann states for 3-component vectors.
Definition m_derived_types.fpp.f90:377
m_derived_types::riemann_states
Left and right Riemann states.
Definition m_derived_types.fpp.f90:371
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:309