MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_riemann_solver_hllc.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2!>
3!! @file
4!! @brief Contains module m_riemann_solver_hllc
5
6!> @brief HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
7# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
8! This file exists so that Fypp can be run without generating case.fpp files for
9! each target. This is useful when generating documentation, for example. This
10! should also let MFC be built with CMake directly, without invoking mfc.sh.
11
12! For pre-process.
13# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
14
15! For moving immersed boundaries in simulation
16# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
17# 7 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
18# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
20# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
21# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
33! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
34! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
35# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
36# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
37# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
38
39# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57! New line at end of file is required for FYPP
58# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
59# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
60# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
61# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
73! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
74! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
75# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
76# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
77# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
78
79# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85
86# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87
88# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
89
90# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
91
92# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
93
94# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
95
96# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
97! New line at end of file is required for FYPP
98# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
99
100# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164
165# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
166
167# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
168
169# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
170
171# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
172
173# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
174
175# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
176! New line at end of file is required for FYPP
177# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
178# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
179# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
180# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
184# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
185
186# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
189
190# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
191# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
192! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
193! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
194# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
195# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
196# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
197
198# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
199# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204
205# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
206
207# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
208
209# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
210
211# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
212
213# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
214
215# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
216! New line at end of file is required for FYPP
217# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
218
219# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262
263# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
264
265# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
266
267# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
268
269# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
270
271# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
272
273# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
274! New line at end of file is required for FYPP
275# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
276
277! GPU parallel region (scalar reductions, maxval/minval)
278# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! GPU parallel loop over threads (most common GPU macro)
281# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Required closing for GPU_PARALLEL_LOOP
284# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Mark routine for device compilation
287# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Declare device-resident data
290# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Inner loop within a GPU parallel region
293# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Scoped GPU data region
296# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Host code with device pointers (for MPI with GPU buffers)
299# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Allocate device memory (unscoped)
302# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Free device memory
305# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Atomic operation on device
308# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! End atomic capture block
311# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Copy data between host and device
314# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Synchronization barrier
317# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Import GPU library module (openacc or omp_lib)
320# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322! Emit code only for AMD compiler
323# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324
325! Emit code for non-Cray compilers
326# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
327
328! Emit code only for Cray compiler
329# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
330
331! Emit code for non-NVIDIA compilers
332# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
333
334# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
335# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
336! New line at end of file is required for FYPP
337# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
338
339# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
340
341! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
342! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
343! example see misc/nvidia_uvm/bind.sh.
344# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Allocate and create GPU device memory
347# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349! Free GPU device memory and deallocate
350# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
351
352! Cray-specific GPU pointer setup for vector fields
353# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
354
355! Cray-specific GPU pointer setup for scalar fields
356# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
357
358! Cray-specific GPU pointer setup for acoustic source spatials
359# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
360
361# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
362
363# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
364! New line at end of file is required for FYPP
365# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
366
367module m_riemann_solver_hllc
368
369 use m_derived_types
370 use m_global_parameters
371 use m_variables_conversion
372 use m_eos
373 use m_bubbles
374 use m_constants, only: riemann_solver_hll, riemann_solver_hllc, riemann_solver_lax_friedrichs, model_eqns_5eq, &
375 & model_eqns_6eq, avg_state_roe, avg_state_arithmetic, wave_speeds_direct, wave_speeds_pressure
376 use m_bubbles_ee
377 use m_surface_tension
378 use m_chemistry
379 use m_thermochem, only: gas_constant, get_mixture_molecular_weight, get_species_enthalpies_rt, molecular_weights
380 use m_thermochem_state, only: get_mixture_caloric_state
381 use m_riemann_state
382
383 implicit none
384
385contains
386
387 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
388 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, &
389 & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
390 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
391
392 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
393 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
394 type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf
395 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
396 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
397
398 ! Intercell fluxes
399 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
400 integer, intent(in) :: norm_dir
401 type(int_bounds_info), intent(in) :: ix, iy, iz
402
403# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
404 real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R
405 real(wp), dimension(num_fluids) :: alpha_L, alpha_R
406 !> Post-limiter volume fractions (alpha_L/R retain the pre-limiter loads used downstream)
407 real(wp), dimension(num_fluids) :: alpha_lim_L, alpha_lim_R
408 real(wp), dimension(num_dims) :: vel_L, vel_R
409# 57 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
410
411 real(wp) :: rho_L, rho_R
412 real(wp) :: pres_L, pres_R
413 real(wp) :: E_L, E_R
414 real(wp) :: H_L, H_R
415 real(wp), dimension(1) :: Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR
416# 63 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
417 real(wp) :: c_sum_Yi_Phi
418 real(wp) :: T_L, T_R
419 real(wp) :: MW_L, MW_R
420 real(wp) :: R_gas_L, R_gas_R
421 real(wp) :: Cp_L, Cp_R
422 real(wp) :: Cv_L, Cv_R
423 real(wp) :: Gamm_L, Gamm_R
424 real(wp) :: Y_L, Y_R
425 real(wp) :: gamma_L, gamma_R
426 real(wp) :: pi_inf_L, pi_inf_R
427 real(wp) :: qv_L, qv_R
428 real(wp) :: c_L, c_R
429 real(wp), dimension(2) :: Re_L, Re_R
430 real(wp) :: rho_avg
431 real(wp) :: H_avg
432 real(wp) :: gamma_avg
433 real(wp) :: qv_avg
434 real(wp) :: c_avg
435 real(wp) :: s_L, s_R, s_M, s_P, s_S
436 real(wp) :: xi_L, xi_R !< Left and right wave speeds functions
437 real(wp) :: xi_L_m1, xi_R_m1 !< xi_L/R - 1, computed without cancellation
438 real(wp) :: xi_M, xi_P
439 real(wp) :: xi_MP, xi_PP
440# 92 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
441 real(wp), dimension(nb) :: R0_L, R0_R
442 real(wp), dimension(nb) :: V0_L, V0_R
443 real(wp), dimension(nb) :: P0_L, P0_R
444 real(wp), dimension(nb) :: pbw_L, pbw_R
445# 97 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
446
447 real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L, nbub_R
448 real(wp) :: ptilde_L, ptilde_R
449 real(wp) :: PbwR3Lbar, PbwR3Rbar
450 real(wp) :: R3Lbar, R3Rbar
451 real(wp) :: R3V2Lbar, R3V2Rbar
452 real(wp), dimension(6) :: tau_e_L, tau_e_R
453 real(wp) :: G_L, G_R
454 real(wp) :: damage_L, damage_R
455 real(wp) :: solid_partial_density_L, solid_partial_density_R
456 real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms
457 real(wp) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_star
458 real(wp) :: alpha_K_star, alpha_rho_K_star, p_isen_L, p_isen_R, e_K_star
459 real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R
460 real(wp) :: pcorr !< low Mach number correction
461 integer :: i, j, k, l, q !< Generic loop iterators
462 integer :: Re_size_loc1, Re_size_loc2 !< host copy of Re_size; amdflang reads the declare-target original stale cross-TU
463
464 ! HLLC star-state helpers
465# 120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
466 real(wp), dimension(sys_size) :: U_L, U_R
467 real(wp), dimension(sys_size) :: F_L, F_R, F_star_L, F_star_R, F_HLLC
468# 123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
469 real(wp) :: u_n_HLLC, u_t_HLLC, u_t2_HLLC
470 real(wp) :: pres_tot_L, pres_tot_R
471 real(wp) :: u_n_L, u_n_R, u_t_L, u_t_R
472 real(wp) :: u_t2_L, u_t2_R
473 real(wp) :: tau_nn_L, tau_nn_R, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R
474 real(wp) :: tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R
475 real(wp) :: tau_qq_L, tau_qq_R
476 real(wp) :: p_face, tau_qq_face
477 real(wp) :: A_L, A_R, denom_A
478 real(wp) :: u_t_star, tau_nt_star
479 real(wp) :: u_t2_star, tau_nt2_star
480 real(wp) :: pres_tot_star
481 integer :: idx_phys
482
483 ! ADC (HLL -> HLLC)
484# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
485 real(wp), dimension(sys_size) :: F_HLL
486# 143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
487 real(wp) :: u_n_HLL_trace, u_t_HLL_trace
488 real(wp) :: u_t2_HLL_trace
489 real(wp) :: p_face_HLL, tau_qq_face_HLL, tau_nn_HLL
490 real(wp) :: phi
491 real(wp) :: Sigma_L, Sigma_R, dSigma, Sigma_ref
492 real(wp) :: a_L_ref, a_R_ref, a_ref
493 real(wp) :: du_t, dtau_nt
494 real(wp) :: du_t2, dtau_nt2
495 real(wp) :: sensor_ptot, sensor_vt, sensor_tnt, sensor_combined
496 real(wp), parameter :: ADC_power = 1.0_wp
497
498 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
499
500 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
501 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
502
503 ! Reshaping inputted data based on dimensional splitting direction
504
505 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
506
507 re_size_loc1 = re_size(1); re_size_loc2 = re_size(2)
508
509# 169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
510# 170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
511# 171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
512 if (norm_dir == 1) then
513# 172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
514 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
515 if (model_eqns == model_eqns_6eq) then
516 ! 6-equation model (model_eqns=3): separate phasic internal energies
517
518# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
519
520# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
521#if defined(MFC_OpenACC)
522# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
523!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, &
524# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
525!$acc& Cp_iL, Cp_iR, R_species, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, 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, &
526# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
527!$acc& gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_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, &
528# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
529!$acc& alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, alpha_K_star, alpha_rho_K_star, &
530# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
531!$acc& p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
532# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
533#elif defined(MFC_OpenMP)
534# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
535
536# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
537
538# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
539
540# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
541!$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, &
542# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
543!$omp& vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, &
544# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
545!$omp& H_R, 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, rho_avg, H_avg, &
546# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
547!$omp& 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, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, &
548# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
549!$omp& s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, alpha_K_star, alpha_rho_K_star, p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
550# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
551#endif
552# 185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
553 do l = is3%beg, is3%end
554# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
555 do k = is2%beg, is2%end
556# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
557 do j = is1%beg, is1%end
558# 188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
559 vel_l_rms = 0._wp; vel_r_rms = 0._wp
560 rho_l = 0._wp; rho_r = 0._wp
561 gamma_l = 0._wp; gamma_r = 0._wp
562 pi_inf_l = 0._wp; pi_inf_r = 0._wp
563 qv_l = 0._wp; qv_r = 0._wp
564 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
565
566
567# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
568#if defined(MFC_OpenACC)
569# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
570!$acc loop seq
571# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
572#elif defined(MFC_OpenMP)
573# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
574
575# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
576#endif
577# 196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
578 do i = 1, num_dims
579 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
580# 198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
581 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
582# 199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
583 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
584 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
585 end do
586
587 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
588# 204 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
589 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
590# 205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
591
592 rho_l = 0._wp
593 gamma_l = 0._wp
594 pi_inf_l = 0._wp
595 qv_l = 0._wp
596
597 rho_r = 0._wp
598 gamma_r = 0._wp
599 pi_inf_r = 0._wp
600 qv_r = 0._wp
601
602 alpha_l_sum = 0._wp
603 alpha_r_sum = 0._wp
604
605 if (mpp_lim) then
606
607# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
608#if defined(MFC_OpenACC)
609# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
610!$acc loop seq
611# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
612#elif defined(MFC_OpenMP)
613# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
614
615# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
616#endif
617# 221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
618 do i = 1, num_fluids
619 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
620# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
621 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
622# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
623 & eqn_idx%E + i)), 1._wp)
624 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
625# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
626 end do
627
628
629# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
630#if defined(MFC_OpenACC)
631# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
632!$acc loop seq
633# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
634#elif defined(MFC_OpenMP)
635# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
636
637# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
638#endif
639# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
640 do i = 1, num_fluids
641 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
642# 231 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
643 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
644# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
645 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
646# 233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
647 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
648# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
649 end do
650
651
652# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
653#if defined(MFC_OpenACC)
654# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
655!$acc loop seq
656# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
657#elif defined(MFC_OpenMP)
658# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
659
660# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
661#endif
662# 237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
663 do i = 1, num_fluids
664 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
665# 239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
666 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
667 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
668# 241 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
669 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
670 end do
671 end if
672
673
674# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
675#if defined(MFC_OpenACC)
676# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
677!$acc loop seq
678# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
679#elif defined(MFC_OpenMP)
680# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
681
682# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
683#endif
684# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
685 do i = 1, num_fluids
686 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
687# 248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
688 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
689# 249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
690 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
691# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
692 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
693# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
694 end do
695
696 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
697 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
698
699 if (viscous) then
700 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
701 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
702 end if
703
704 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
705 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
706
707 h_l = (e_l + pres_l)/rho_l
708 h_r = (e_r + pres_r)/rho_r
709
710 ! Only the Roe path writes this, and chemistry is unreachable at model_eqns = 6eq; zero it
711 ! so the sound speed below never reads an undefined value.
712 c_sum_yi_phi = 0._wp
713
714 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
715 ! average costs eight square roots per face.
716 if (wave_speeds == wave_speeds_pressure) then
717 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, &
718 & qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
719 end if
720
721 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
722
723 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
724
725 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
726 ! costs eight square roots per face under the Roe average.
727 if (wave_speeds == wave_speeds_pressure) then
728 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
729 & h_avg, c_sum_yi_phi, alpha_r, c_avg, alpha_rho_r)
730 end if
731
732 if (viscous) then
733
734# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
735#if defined(MFC_OpenACC)
736# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
737!$acc loop seq
738# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
739#elif defined(MFC_OpenMP)
740# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
741
742# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
743#endif
744# 291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
745 do i = 1, 2
746 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
747# 293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
748 end do
749 end if
750
751 ! Low Mach correction
752 if (low_mach == 2) then
753 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
754 & vel_r(dir_idx(1)))
755 end if
756
757 ! COMPUTING THE DIRECT WAVE SPEEDS
758 if (wave_speeds == wave_speeds_direct) then
759 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
760 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
761 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
762 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
763 & - rho_r*(s_r - vel_r(dir_idx(1))))
764 else if (wave_speeds == wave_speeds_pressure) then
765 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
766
767 pres_sr = pres_sl
768
769 ! Low Mach correction: Thornber et al. JCP (2008)
770 ms_l = max(1._wp, &
771 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
772 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
773 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
774 ms_r = max(1._wp, &
775 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
776 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
777 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
778
779 s_l = vel_l(dir_idx(1)) - c_l*ms_l
780 s_r = vel_r(dir_idx(1)) + c_r*ms_r
781
782 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
783 end if
784
785 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
786 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
787
788 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
789 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
790 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
791 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
792 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
793
794 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
795 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
796 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
797
798 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
799 xi_mp = -min(0._wp, sign(1._wp, s_l))
800 xi_pp = max(0._wp, sign(1._wp, s_r))
801
802 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l &
803 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
804 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
805 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
806 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
807
808 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
809
810 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + xi_mp*xi_pp*(s_s &
811 & - vel_r(dir_idx(1)))
812
813 ! Low Mach correction
814 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
815 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
816
817 ! COMPUTING FLUXES MASS FLUX.
818
819# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
820#if defined(MFC_OpenACC)
821# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
822!$acc loop seq
823# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
824#elif defined(MFC_OpenMP)
825# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
826
827# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
828#endif
829# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
830 do i = 1, eqn_idx%cont%end
831 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
832# 366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
833 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
834# 367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
835 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
836 end do
837
838 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
839
840# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
841#if defined(MFC_OpenACC)
842# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
843!$acc loop seq
844# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
845#elif defined(MFC_OpenMP)
846# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
847
848# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
849#endif
850# 372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
851 do i = 1, num_dims
852 flux_rsx_vf(j, k, l, &
853# 374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
854 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
855 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
856 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
857 & *dir_flg(dir_idx(i))*pcorr
858 end do
859
860 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
861 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
862# 382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
863
864 ! VOLUME FRACTION FLUX.
865
866# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
867#if defined(MFC_OpenACC)
868# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
869!$acc loop seq
870# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
871#elif defined(MFC_OpenMP)
872# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
873
874# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
875#endif
876# 385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
877 do i = eqn_idx%adv%beg, eqn_idx%adv%end
878 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
879# 387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
880 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
881# 388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
882 end do
883
884 ! Advection velocity source: interface velocity for volume fraction transport
885
886# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
887#if defined(MFC_OpenACC)
888# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
889!$acc loop seq
890# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
891#elif defined(MFC_OpenMP)
892# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
893
894# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
895#endif
896# 392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
897 do i = 1, num_dims
898 vel_src_rsx_vf(j, k, l, &
899# 394 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
900 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
901 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
902 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
903 end do
904
905 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
906 ! energy flux
907
908# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
909#if defined(MFC_OpenACC)
910# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
911!$acc loop seq
912# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
913#elif defined(MFC_OpenMP)
914# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
915
916# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
917#endif
918# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
919 do i = 1, num_fluids
920 ! Phasic isentrope p* from the upwind state: closed form for stiffened gas, integrated
921 ! for a state-dependent EOS.
922 call s_phase_pressure_on_isentrope(pres_l, alpha_rho_l(i)/max(alpha_l(i), sgm_eps), xi_l, i, &
923 & p_isen_l)
924 call s_phase_pressure_on_isentrope(pres_r, alpha_rho_r(i)/max(alpha_r(i), sgm_eps), xi_r, i, &
925 & p_isen_r)
926 p_k_star = xi_m*(xi_mp*(p_isen_l - pres_l) + pres_l) + xi_p*(xi_pp*(p_isen_r - pres_r) + pres_r)
927
928 alpha_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
929# 412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
930 & i + eqn_idx%adv%beg - 1) &
931 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
932# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
933 & i + eqn_idx%adv%beg - 1)
934 alpha_rho_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
935# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
936 & i + eqn_idx%cont%beg - 1) &
937 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
938# 418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
939 & i + eqn_idx%cont%beg - 1)
940 ! Star partial density xi_K alpha_rho, blended like p_K_Star: a state-dependent EOS reads
941 ! its coefficients at the star density, not the upwind one.
942 call s_phase_internal_energy(p_k_star, alpha_k_star, &
943 & alpha_rho_k_star*(1._wp + xi_m*xi_mp*(xi_l - 1._wp) &
944 & + xi_p*xi_pp*(xi_r - 1._wp)), i, e_k_star)
945 flux_rsx_vf(j, k, l, &
946# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
947 & i + eqn_idx%int_en%beg - 1) = e_k_star*vel_k_star + (s_m/s_l)*(s_p/s_r) &
948 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
949# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
950 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
951# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
952 & i + eqn_idx%adv%beg - 1))
953 end do
954
955 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
956# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
957
958 ! COLOR FUNCTION FLUX
959 if (surface_tension) then
960 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
961# 436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
962 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
963# 437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
964 end if
965
966 ! Geometrical source flux for cylindrical coordinates
967# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
968# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
969 end do
970 end do
971 end do
972
973# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
974#if defined(MFC_OpenACC)
975# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
976!$acc end parallel loop
977# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
978#elif defined(MFC_OpenMP)
979# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
980
981# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
982!$omp end target teams loop
983# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
984#endif
985# 479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
986 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
987 ! 5-equation model with Euler-Euler bubble dynamics
988
989# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
990
991# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
992#if defined(MFC_OpenACC)
993# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
994!$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, alpha_rho_L, alpha_rho_R, h_avg, &
995# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
996!$acc& gamma_avg, Re_L, Re_R, pcorr, 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, &
997# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
998!$acc& Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, &
999# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1000!$acc& R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR) firstprivate(Re_size_loc1, Re_size_loc2)
1001# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1002#elif defined(MFC_OpenMP)
1003# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1004
1005# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1006
1007# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1008
1009# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1010!$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, &
1011# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1012!$omp& R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, &
1013# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1014!$omp& 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, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, &
1015# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1016!$omp& s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR) &
1017# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1018!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
1019# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1020#endif
1021# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1022 do l = is3%beg, is3%end
1023# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1024 do k = is2%beg, is2%end
1025# 491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1026 do j = is1%beg, is1%end
1027# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1028 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1029 rho_l = 0._wp; rho_r = 0._wp
1030 gamma_l = 0._wp; gamma_r = 0._wp
1031 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1032 qv_l = 0._wp; qv_r = 0._wp
1033
1034
1035# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1036#if defined(MFC_OpenACC)
1037# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1038!$acc loop seq
1039# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1040#elif defined(MFC_OpenMP)
1041# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1042
1043# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1044#endif
1045# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1046 do i = 1, num_fluids
1047 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1048# 501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1049 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1050# 502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1051 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1052# 503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1053 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1054# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1055 end do
1056
1057 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1058
1059
1060# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1061#if defined(MFC_OpenACC)
1062# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1063!$acc loop seq
1064# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1065#elif defined(MFC_OpenMP)
1066# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1067
1068# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1069#endif
1070# 509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1071 do i = 1, num_dims
1072 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1073# 511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1074 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1075# 512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1076 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1077 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1078 end do
1079
1080 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
1081 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
1082
1083 if (viscous) then
1084 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
1085
1086# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1087#if defined(MFC_OpenACC)
1088# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1089!$acc loop seq
1090# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1091#elif defined(MFC_OpenMP)
1092# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1093
1094# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1095#endif
1096# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1097 do i = 1, 2
1098 re_l(i) = dflt_real
1099 re_r(i) = dflt_real
1100
1101 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
1102 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
1103
1104
1105# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1106#if defined(MFC_OpenACC)
1107# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1108!$acc loop seq
1109# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1110#elif defined(MFC_OpenMP)
1111# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1112
1113# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1114#endif
1115# 530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1116 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
1117 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
1118# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1119 & q)))/res_gs(i, q) + re_l(i)
1120 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
1121# 534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1122 & q)))/res_gs(i, q) + re_r(i)
1123 end do
1124
1125 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1126 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1127 end do
1128 end if
1129 end if
1130
1131 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1132# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1133 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1134# 545 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1135
1136 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
1137 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
1138
1139 h_l = (e_l + pres_l)/rho_l
1140 h_r = (e_r + pres_r)/rho_r
1141
1142 if (avg_state == avg_state_arithmetic) then
1143
1144# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1145#if defined(MFC_OpenACC)
1146# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1147!$acc loop seq
1148# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1149#elif defined(MFC_OpenMP)
1150# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1151
1152# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1153#endif
1154# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1155 do i = 1, nb
1156 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
1157# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1158 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
1159# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1160
1161 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
1162# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1163 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
1164# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1165 if (.not. polytropic .and. .not. qbmm) then
1166 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
1167# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1168 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
1169# 563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1170 end if
1171 end do
1172
1173 if (.not. qbmm) then
1174 if (adv_n) then
1175 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
1176# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1177 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
1178# 570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1179 else
1180 nbub_l = 0._wp
1181 nbub_r = 0._wp
1182
1183# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1184#if defined(MFC_OpenACC)
1185# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1186!$acc loop seq
1187# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1188#elif defined(MFC_OpenMP)
1189# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1190
1191# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1192#endif
1193# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1194 do i = 1, nb
1195 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
1196 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
1197 end do
1198
1199 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
1200# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1201 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
1202# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1203 & eqn_idx%E + num_fluids)/nbub_r
1204 end if
1205 else
1206 ! nb stored in 0th moment of first R0 bin in variable conversion module
1207 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
1208# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1209 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
1210# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1211 end if
1212
1213
1214# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1215#if defined(MFC_OpenACC)
1216# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1217!$acc loop seq
1218# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1219#elif defined(MFC_OpenMP)
1220# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1221
1222# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1223#endif
1224# 590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1225 do i = 1, nb
1226 if (.not. qbmm) then
1227 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
1228 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
1229 end if
1230 end do
1231
1232 if (qbmm) then
1233 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
1234# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1235 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
1236# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1237
1238 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
1239# 602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1240 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
1241# 603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1242
1243 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
1244# 605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1245 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
1246# 606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1247 else
1248 pbwr3lbar = 0._wp
1249 pbwr3rbar = 0._wp
1250
1251 r3lbar = 0._wp
1252 r3rbar = 0._wp
1253
1254 r3v2lbar = 0._wp
1255 r3v2rbar = 0._wp
1256
1257
1258# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1259#if defined(MFC_OpenACC)
1260# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1261!$acc loop seq
1262# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1263#elif defined(MFC_OpenMP)
1264# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1265
1266# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1267#endif
1268# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1269 do i = 1, nb
1270 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
1271 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
1272
1273 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
1274 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
1275
1276 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
1277 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
1278 end do
1279 end if
1280
1281 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1282 h_avg = 5.e-1_wp*(h_l + h_r)
1283 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1284 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1285 vel_avg_rms = 0._wp
1286
1287
1288# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1289#if defined(MFC_OpenACC)
1290# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1291!$acc loop seq
1292# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1293#elif defined(MFC_OpenMP)
1294# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1295
1296# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1297#endif
1298# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1299 do i = 1, num_dims
1300 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1301 end do
1302 end if
1303
1304 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
1305
1306 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
1307
1308 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
1309 ! costs eight square roots per face under the Roe average.
1310 if (wave_speeds == wave_speeds_pressure) then
1311 ! Zero, not c_sum_Yi_Phi: this loop never forms the chemistry average, and
1312 ! chemistry with bubbles_euler/qbmm is prohibited, so the branch is unreachable.
1313 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
1314 & h_avg, 0._wp, alpha_r, c_avg, alpha_rho_r)
1315 end if
1316
1317 if (viscous) then
1318
1319# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1320#if defined(MFC_OpenACC)
1321# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1322!$acc loop seq
1323# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1324#elif defined(MFC_OpenMP)
1325# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1326
1327# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1328#endif
1329# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1330 do i = 1, 2
1331 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1332# 658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1333 end do
1334 end if
1335
1336 ! Low Mach correction
1337 if (low_mach == 2) then
1338 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
1339 & vel_r(dir_idx(1)))
1340 end if
1341
1342 if (wave_speeds == wave_speeds_direct) then
1343 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1344 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1345
1346 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1347 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1348 & - rho_r*(s_r - vel_r(dir_idx(1))))
1349 else if (wave_speeds == wave_speeds_pressure) then
1350 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1351
1352 pres_sr = pres_sl
1353
1354 ! Low Mach correction: Thornber et al. JCP (2008)
1355 ms_l = max(1._wp, &
1356 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
1357 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
1358 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
1359 ms_r = max(1._wp, &
1360 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
1361 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
1362 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
1363
1364 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1365 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1366
1367 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1368 end if
1369
1370 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1371 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1372
1373 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1374 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1375 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1376 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1377 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1378
1379 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1380 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1381 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1382
1383 ! Low Mach correction
1384 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
1385 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
1386
1387
1388# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1389#if defined(MFC_OpenACC)
1390# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1391!$acc loop seq
1392# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1393#elif defined(MFC_OpenMP)
1394# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1395
1396# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1397#endif
1398# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1399 do i = 1, eqn_idx%cont%end
1400 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1401# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1402 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1403# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1404 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1405 end do
1406
1407 if (bubbles_euler .and. (num_fluids > 1)) then
1408 ! Kill mass transport @ gas density
1409 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
1410# 722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1411 end if
1412
1413 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1414
1415 ! Include p_tilde
1416
1417 if (avg_state == avg_state_arithmetic) then
1418 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
1419 pres_l = pres_l - alpha_l(num_fluids)*pres_l
1420 else
1421 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
1422 end if
1423
1424 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
1425 pres_r = pres_r - alpha_r(num_fluids)*pres_r
1426 else
1427 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
1428 end if
1429 end if
1430
1431
1432# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1433#if defined(MFC_OpenACC)
1434# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1435!$acc loop seq
1436# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1437#elif defined(MFC_OpenMP)
1438# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1439
1440# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1441#endif
1442# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1443 do i = 1, num_dims
1444 flux_rsx_vf(j, k, l, &
1445# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1446 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
1447 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1448 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
1449 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1450 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1451 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
1452 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
1453 end do
1454
1455 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
1456 flux_rsx_vf(j, k, l, &
1457# 756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1458 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
1459 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
1460 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
1461 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
1462 & *pcorr*s_s
1463
1464 ! Volume fraction flux
1465
1466# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1467#if defined(MFC_OpenACC)
1468# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1469!$acc loop seq
1470# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1471#elif defined(MFC_OpenMP)
1472# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1473
1474# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1475#endif
1476# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1477 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1478 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1479# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1480 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1481# 767 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1482 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1483 end do
1484
1485 ! Advection velocity source: interface velocity for volume fraction transport
1486
1487# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1488#if defined(MFC_OpenACC)
1489# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1490!$acc loop seq
1491# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1492#elif defined(MFC_OpenMP)
1493# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1494
1495# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1496#endif
1497# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1498 do i = 1, num_dims
1499 vel_src_rsx_vf(j, k, l, &
1500# 774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1501 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
1502 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
1503 end do
1504
1505 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1506# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1507
1508 ! Add advection flux for bubble variables
1509
1510# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1511#if defined(MFC_OpenACC)
1512# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1513!$acc loop seq
1514# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1515#elif defined(MFC_OpenMP)
1516# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1517
1518# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1519#endif
1520# 782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1521 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1522 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
1523# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1524 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1525 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1526# 786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1527 end do
1528
1529 if (qbmm) then
1530 flux_rsx_vf(j, k, l, &
1531# 790 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1532 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1533 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1534 end if
1535
1536 if (adv_n) then
1537 flux_rsx_vf(j, k, l, &
1538# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1539 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1540 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1541 end if
1542
1543 ! Geometrical source flux for cylindrical coordinates
1544# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1545# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1546 end do
1547 end do
1548 end do
1549
1550# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1551#if defined(MFC_OpenACC)
1552# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1553!$acc end parallel loop
1554# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1555#elif defined(MFC_OpenMP)
1556# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1557
1558# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1559!$omp end target teams loop
1560# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1561#endif
1562# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1563# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1564# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1565 else if (hypoelasticity) then
1566# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1567 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
1568 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
1569 ! statement and private variable from the pure-fluid emission, keeping its body and directive
1570 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
1571 ! pinned it at the GPU register ceiling for every HLLC user.
1572 ! One source of truth for this kernel's private variables: both emissions of the shared body take
1573 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
1574 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
1575 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
1576# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1577# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1578# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1579# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1580# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1581# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1582# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1583# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1584# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1585# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1586# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1587# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1588# 879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1589# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1590# 886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1591 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
1592 ! both emissions the same name; amdflang then launches the wrong one and a
1593 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
1594 ! give two line numbers. Do not merge them back into one (still faults on AFAR 24.3).
1595# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1596
1597# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1598
1599# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1600#if defined(MFC_OpenACC)
1601# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1602!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, 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, &
1603# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1604!$acc& 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, c_sum_Yi_Phi, 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, &
1605# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1606!$acc& s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, &
1607# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1608!$acc& vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR, ptilde_L, ptilde_R, tau_e_L, tau_e_R, G_L, G_R, damage_L, damage_R, solid_partial_density_L, &
1609# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1610!$acc& solid_partial_density_R, U_L, U_R, F_L, F_R, F_star_L, F_star_R, F_HLLC, u_n_HLLC, u_t_HLLC, u_t2_HLLC, pres_tot_L, pres_tot_R, u_n_L, u_n_R, u_t_L, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nn_R, &
1611# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1612!$acc& tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, p_face, tau_qq_face, A_L, A_R, denom_A, u_t_star, tau_nt_star, &
1613# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1614!$acc& u_t2_star, tau_nt2_star, pres_tot_star, F_HLL, u_n_HLL_trace, u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, &
1615# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1616!$acc& a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
1617# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1618#elif defined(MFC_OpenMP)
1619# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1620
1621# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1622
1623# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1624
1625# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1626!$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, &
1627# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1628!$omp& 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, &
1629# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1630!$omp& Cv_L, Cv_R, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, &
1631# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1632!$omp& pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
1633# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1634!$omp& Cp_iR, R_species, h_iL, h_iR, ptilde_L, ptilde_R, tau_e_L, tau_e_R, G_L, G_R, damage_L, damage_R, solid_partial_density_L, solid_partial_density_R, U_L, U_R, F_L, F_R, F_star_L, F_star_R, &
1635# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1636!$omp& F_HLLC, u_n_HLLC, u_t_HLLC, u_t2_HLLC, pres_tot_L, pres_tot_R, u_n_L, u_n_R, u_t_L, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nn_R, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, tau_nt2_L, tau_nt2_R, &
1637# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1638!$omp& tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, p_face, tau_qq_face, A_L, A_R, denom_A, u_t_star, tau_nt_star, u_t2_star, tau_nt2_star, pres_tot_star, F_HLL, u_n_HLL_trace, &
1639# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1640!$omp& u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, &
1641# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1642!$omp& sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
1643# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1644#endif
1645# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1646# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1647 do l = is3%beg, is3%end
1648# 898 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1649 do k = is2%beg, is2%end
1650# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1651 do j = is1%beg, is1%end
1652# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1653 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1654 rho_l = 0._wp; rho_r = 0._wp
1655 gamma_l = 0._wp; gamma_r = 0._wp
1656 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1657 qv_l = 0._wp; qv_r = 0._wp
1658 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
1659
1660
1661# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1662#if defined(MFC_OpenACC)
1663# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1664!$acc loop seq
1665# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1666#elif defined(MFC_OpenMP)
1667# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1668
1669# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1670#endif
1671# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1672 do i = 1, num_fluids
1673 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1674# 910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1675 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1676# 911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1677 end do
1678
1679
1680# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1681#if defined(MFC_OpenACC)
1682# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1683!$acc loop seq
1684# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1685#elif defined(MFC_OpenMP)
1686# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1687
1688# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1689#endif
1690# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1691 do i = 1, num_dims
1692 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1693# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1694 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1695# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1696 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1697 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1698 end do
1699
1700 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1701# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1702 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1703# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1704
1705# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1706
1707# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1708#if defined(MFC_OpenACC)
1709# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1710!$acc loop seq
1711# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1712#elif defined(MFC_OpenMP)
1713# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1714
1715# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1716#endif
1717# 926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1718 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1719 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1720# 928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1721 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
1722# 929 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1723 end do
1724
1725 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
1726 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
1727 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
1728 if (n > 0) then
1729 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
1730 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
1731 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
1732 end if
1733 if (p > 0) then
1734 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
1735 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
1736 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
1737 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
1738 end if
1739 pres_tot_l = pres_l - tau_nn_l
1740 pres_tot_r = pres_r - tau_nn_r
1741 if (cyl_coord) then
1742 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1743 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1744 else
1745 tau_qq_l = 0._wp
1746 tau_qq_r = 0._wp
1747 end if
1748# 955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1749
1750 ! Change this by splitting it into the cases present in the bubbles_euler
1751 if (mpp_lim) then
1752
1753# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1754#if defined(MFC_OpenACC)
1755# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1756!$acc loop seq
1757# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1758#elif defined(MFC_OpenMP)
1759# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1760
1761# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1762#endif
1763# 959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1764 do i = 1, num_fluids
1765 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
1766# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1767 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
1768# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1769 & eqn_idx%E + i)), 1._wp)
1770 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
1771# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1772 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
1773# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1774 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
1775# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1776 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1777# 967 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1778 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1779# 968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1780 end do
1781
1782
1783# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1784#if defined(MFC_OpenACC)
1785# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1786!$acc loop seq
1787# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1788#elif defined(MFC_OpenMP)
1789# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1790
1791# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1792#endif
1793# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1794 do i = 1, num_fluids
1795 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
1796# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1797 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
1798 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
1799# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1800 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
1801 end do
1802 end if
1803
1804 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
1805 ! downstream
1806
1807# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1808#if defined(MFC_OpenACC)
1809# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1810!$acc loop seq
1811# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1812#elif defined(MFC_OpenMP)
1813# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1814
1815# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1816#endif
1817# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1818 do i = 1, num_fluids
1819 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1820# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1821 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1822# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1823 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1824# 986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1825 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1826# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1827 end do
1828
1829 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
1830 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
1831
1832 if (viscous) then
1833 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
1834 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
1835 end if
1836
1837 if (chemistry) then
1838 c_sum_yi_phi = 0.0_wp
1839
1840# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1841#if defined(MFC_OpenACC)
1842# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1843!$acc loop seq
1844# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1845#elif defined(MFC_OpenMP)
1846# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1847
1848# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1849#endif
1850# 1000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1851 do i = eqn_idx%species%beg, eqn_idx%species%end
1852 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
1853# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1854 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
1855# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1856 end do
1857
1858 call get_mixture_molecular_weight(ys_l, mw_l)
1859 call get_mixture_molecular_weight(ys_r, mw_r)
1860
1861 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
1862 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
1863
1864 r_gas_l = gas_constant/mw_l
1865 r_gas_r = gas_constant/mw_r
1866
1867 t_l = pres_l/rho_l/r_gas_l
1868 t_r = pres_r/rho_r/r_gas_r
1869
1870 call get_mixture_caloric_state(t_l, ys_l, cp_il, cp_l, cv_l, e_l)
1871 call get_mixture_caloric_state(t_r, ys_r, cp_ir, cp_r, cv_r, e_r)
1872
1873 if (chem_params%gamma_method == 1) then
1874 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1875 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
1876 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
1877
1878 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
1879 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
1880 else if (chem_params%gamma_method == 2) then
1881 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1882 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
1883 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1884 end if
1885
1886 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1887 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1888 h_l = (e_l + pres_l)/rho_l
1889 h_r = (e_r + pres_r)/rho_r
1890 else
1891 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
1892 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
1893
1894 h_l = (e_l + pres_l)/rho_l
1895 h_r = (e_r + pres_r)/rho_r
1896 end if
1897
1898# 1046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1899 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
1900
1901# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1902#if defined(MFC_OpenACC)
1903# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1904!$acc loop seq
1905# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1906#elif defined(MFC_OpenMP)
1907# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1908
1909# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1910#endif
1911# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1912 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1913 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1914# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1915 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
1916# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1917 end do
1918 damage_l = 0._wp; damage_r = 0._wp
1919 if (cont_damage) then
1920 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
1921# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1922 damage_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%damage)
1923# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1924 end if
1925
1926 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
1927 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
1928 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
1929 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
1930 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
1931 ! keep their pre-adjustment values here.
1932# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1933
1934 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
1935 ! average costs eight square roots per face.
1936 if (wave_speeds == wave_speeds_pressure) then
1937 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
1938 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
1939 if (chemistry .and. avg_state == avg_state_roe) then
1940 r_species(1:num_species) = gas_constant/molecular_weights
1941 call get_species_enthalpies_rt(t_l, h_il)
1942 call get_species_enthalpies_rt(t_r, h_ir)
1943 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
1944 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
1945 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
1946 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
1947 & gamma_avg, c_sum_yi_phi)
1948 end if
1949 end if
1950
1951 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
1952
1953 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
1954
1955 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
1956 ! costs eight square roots per face under the Roe average.
1957 if (wave_speeds == wave_speeds_pressure) then
1958 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
1959 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
1960 & alpha_rho_r)
1961 end if
1962
1963 if (viscous) then
1964 if (chemistry) then
1965 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1966 end if
1967
1968# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1969#if defined(MFC_OpenACC)
1970# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1971!$acc loop seq
1972# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1973#elif defined(MFC_OpenMP)
1974# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1975
1976# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1977#endif
1978# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1979 do i = 1, 2
1980 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1981# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1982 end do
1983 end if
1984
1985 ! Low Mach correction
1986 if (low_mach == 2) then
1987 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
1988 & vel_r(dir_idx(1)))
1989 end if
1990
1991 if (wave_speeds == wave_speeds_direct) then
1992# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1993 ! Elastic wave speed, Rodriguez et al. JCP (2019)
1994 s_l = min(vel_l(dir_idx(1)) - f_elastic_signal_speed(c_l, g_l, &
1995 & tau_e_l(dir_idx_tau(1)), rho_l), &
1996 & vel_r(dir_idx(1)) - f_elastic_signal_speed(c_r, g_r, &
1997 & tau_e_r(dir_idx_tau(1)), rho_r))
1998 s_r = max(vel_r(dir_idx(1)) + f_elastic_signal_speed(c_r, g_r, &
1999 & tau_e_r(dir_idx_tau(1)), rho_r), &
2000 & vel_l(dir_idx(1)) + f_elastic_signal_speed(c_l, g_l, &
2001 & tau_e_l(dir_idx_tau(1)), rho_l))
2002 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
2003 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
2004 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
2005 & - vel_r(dir_idx(1))))
2006# 1136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2007 else if (wave_speeds == wave_speeds_pressure) then
2008 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2009
2010 pres_sr = pres_sl
2011
2012 ! Low Mach correction: Thornber et al. JCP (2008)
2013 ms_l = max(1._wp, &
2014 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
2015 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
2016 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
2017 ms_r = max(1._wp, &
2018 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
2019 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
2020 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
2021
2022 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2023 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2024
2025 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2026 end if
2027
2028 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2029 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2030
2031 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2032 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2033 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2034 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
2035 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2036 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2037
2038 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2039 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2040 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2041
2042 ! Low Mach correction
2043 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
2044 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
2045
2046# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2047 if (n == 0) then
2048 u_t_l = 0._wp; u_t_r = 0._wp
2049 tau_nt_l = 0._wp; tau_nt_r = 0._wp
2050 end if
2051 if (p == 0) then
2052 u_t2_l = 0._wp; u_t2_r = 0._wp
2053 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
2054 end if
2055 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
2056 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
2057 denom_a = a_r - a_l
2058 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
2059 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
2060 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
2061 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
2062 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
2063# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2064
2065 ! COMPUTING THE HLLC FLUXES MASS FLUX.
2066
2067# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2068#if defined(MFC_OpenACC)
2069# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2070!$acc loop seq
2071# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2072#elif defined(MFC_OpenMP)
2073# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2074
2075# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2076#endif
2077# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2078 do i = 1, eqn_idx%cont%end
2079 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2080# 1198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2081 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2082# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2083 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2084 end do
2085
2086# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2087 flux_rsx_vf(j, k, l, &
2088# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2089 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
2090 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
2091 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
2092 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
2093 if (n > 0) then
2094 flux_rsx_vf(j, k, l, &
2095# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2096 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
2097 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
2098 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
2099 & - tau_nt_r)
2100 end if
2101 if (p > 0) then
2102 flux_rsx_vf(j, k, l, &
2103# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2104 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
2105 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
2106 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
2107 & - tau_nt2_r)
2108 end if
2109
2110 flux_rsx_vf(j, k, l, &
2111# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2112 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
2113 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
2114 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
2115 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
2116 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
2117 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
2118 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
2119 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
2120 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
2121 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
2122
2123 if (n == 0) then
2124 flux_rsx_vf(j, k, l, &
2125# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2126 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
2127 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
2128 & + s_p*(xi_r - 1._wp))
2129 else if (p == 0) then
2130 if (dir_idx(1) == 1) then
2131 flux_rsx_vf(j, k, l, &
2132# 1243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2133 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
2134 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
2135 & + s_p*(xi_r - 1._wp))
2136 flux_rsx_vf(j, k, l, &
2137# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2138 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
2139 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
2140 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
2141 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
2142 flux_rsx_vf(j, k, l, &
2143# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2144 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
2145 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
2146 & + s_p*(xi_r - 1._wp))
2147 else
2148 flux_rsx_vf(j, k, l, &
2149# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2150 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
2151 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
2152 & + s_p*(xi_r - 1._wp))
2153 flux_rsx_vf(j, k, l, &
2154# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2155 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
2156 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
2157 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
2158 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
2159 flux_rsx_vf(j, k, l, &
2160# 1266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2161 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
2162 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
2163 & + s_p*(xi_r - 1._wp))
2164 end if
2165 else
2166 flux_rsx_vf(j, k, l, &
2167# 1272 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2168 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
2169 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2170 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2171 flux_rsx_vf(j, k, l, &
2172# 1276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2173 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
2174 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
2175 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
2176 & - rho_r*tau_nt_r))
2177 flux_rsx_vf(j, k, l, &
2178# 1281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2179 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
2180 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
2181 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
2182 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
2183 flux_rsx_vf(j, k, l, &
2184# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2185 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
2186 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2187 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2188 flux_rsx_vf(j, k, l, &
2189# 1290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2190 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
2191 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2192 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2193 flux_rsx_vf(j, k, l, &
2194# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2195 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
2196 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2197 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2198 end if
2199 if (cyl_coord) then
2200 flux_rsx_vf(j, k, l, &
2201# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2202 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
2203 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
2204 & + s_p*(xi_r - 1._wp))
2205 end if
2206
2207 ! Damage flux: U_D = m_s*D (damageable-solid partial mass)
2208 if (cont_damage) then
2209 solid_partial_density_l = 0._wp; solid_partial_density_r = 0._wp
2210
2211# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2212#if defined(MFC_OpenACC)
2213# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2214!$acc loop seq
2215# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2216#elif defined(MFC_OpenMP)
2217# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2218
2219# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2220#endif
2221# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2222 do i = 1, num_fluids
2223 if (gs_rs(i) > verysmall) then
2224 solid_partial_density_l = solid_partial_density_l + alpha_rho_l(i)
2225 solid_partial_density_r = solid_partial_density_r + alpha_rho_r(i)
2226 end if
2227 end do
2228 flux_rsx_vf(j, k, l, &
2229# 1316 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2230 & eqn_idx%damage) &
2231 & = xi_m*solid_partial_density_l*damage_l*(vel_l(dir_idx(1)) + s_m*(xi_l &
2232 & - 1._wp)) + xi_p*solid_partial_density_r*damage_r*(vel_r(dir_idx(1)) &
2233 & + s_p*(xi_r - 1._wp))
2234 end if
2235
2236 if (s_l >= 0._wp) then
2237 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
2238 else if (s_r <= 0._wp) then
2239 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
2240 else
2241 u_n_hllc = s_s*(xi_m*xi_l + xi_p*xi_r); u_t_hllc = u_t_star; u_t2_hllc = u_t2_star
2242 end if
2243 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2244# 1330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2245 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2246# 1331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2247 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2248# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2249# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2250
2251 ! VOLUME FRACTION FLUX.
2252
2253# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2254#if defined(MFC_OpenACC)
2255# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2256!$acc loop seq
2257# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2258#elif defined(MFC_OpenMP)
2259# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2260
2261# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2262#endif
2263# 1359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2264 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2265 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2266# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2267 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2268# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2269 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2270 end do
2271
2272 ! VOLUME FRACTION SOURCE FLUX.
2273
2274# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2275#if defined(MFC_OpenACC)
2276# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2277!$acc loop seq
2278# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2279#elif defined(MFC_OpenMP)
2280# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2281
2282# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2283#endif
2284# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2285 do i = 1, num_dims
2286 vel_src_rsx_vf(j, k, l, &
2287# 1369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2288 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2289 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2290 end do
2291
2292 ! COLOR FUNCTION FLUX
2293 if (surface_tension) then
2294 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
2295# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2296 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2297 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2298# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2299 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2300 end if
2301
2302 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2303# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2304
2305 if (chemistry) then
2306
2307# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2308#if defined(MFC_OpenACC)
2309# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2310!$acc loop seq
2311# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2312#elif defined(MFC_OpenMP)
2313# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2314
2315# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2316#endif
2317# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2318 do i = eqn_idx%species%beg, eqn_idx%species%end
2319 y_l = ql_prim_rsx_vf(j, k, l, i)
2320# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2321 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
2322# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2323
2324 flux_rsx_vf(j, k, l, &
2325# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2326 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2327 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2328 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
2329# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2330 end do
2331 end if
2332
2333# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2334 ! HLLC-ADC blending for hypoelasticity
2335 if (riemann_hypo_adc) then
2336 ! Build U_L, U_R and F_L, F_R in local-basis layout
2337
2338# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2339#if defined(MFC_OpenACC)
2340# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2341!$acc loop seq
2342# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2343#elif defined(MFC_OpenMP)
2344# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2345
2346# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2347#endif
2348# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2349 do i = 1, num_fluids
2350 u_l(i) = alpha_rho_l(i)
2351 u_r(i) = alpha_rho_r(i)
2352 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
2353 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
2354 f_l(i) = alpha_rho_l(i)*u_n_l
2355 f_r(i) = alpha_rho_r(i)*u_n_r
2356 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
2357 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
2358 end do
2359
2360 ! Momentum U/F in physical order via dir_idx
2361 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
2362 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
2363 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
2364 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
2365 if (n > 0) then
2366 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
2367 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
2368 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
2369 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
2370 end if
2371 if (p > 0) then
2372 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
2373 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
2374 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
2375 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
2376 end if
2377
2378 u_l(eqn_idx%E) = e_l
2379 u_r(eqn_idx%E) = e_r
2380 f_l(eqn_idx%E) = (e_l + pres_tot_l)*u_n_l - u_t_l*tau_nt_l - u_t2_l*tau_nt2_l
2381 f_r(eqn_idx%E) = (e_r + pres_tot_r)*u_n_r - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r
2382
2383 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
2384
2385# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2386#if defined(MFC_OpenACC)
2387# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2388!$acc loop seq
2389# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2390#elif defined(MFC_OpenMP)
2391# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2392
2393# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2394#endif
2395# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2396 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
2397 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
2398 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
2399 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
2400 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
2401 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
2402 end do
2403 if (cyl_coord) then
2404 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
2405 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
2406 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
2407 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
2408 end if
2409
2410 ! Compute F_HLL (physical order) and HLL trace velocities
2411 if (s_l >= 0._wp) then
2412
2413# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2414#if defined(MFC_OpenACC)
2415# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2416!$acc loop seq
2417# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2418#elif defined(MFC_OpenMP)
2419# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2420
2421# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2422#endif
2423# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2424 do i = 1, sys_size
2425 f_hll(i) = f_l(i)
2426 end do
2427 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
2428 else if (s_r <= 0._wp) then
2429
2430# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2431#if defined(MFC_OpenACC)
2432# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2433!$acc loop seq
2434# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2435#elif defined(MFC_OpenMP)
2436# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2437
2438# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2439#endif
2440# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2441 do i = 1, sys_size
2442 f_hll(i) = f_r(i)
2443 end do
2444 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
2445 else
2446
2447# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2448#if defined(MFC_OpenACC)
2449# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2450!$acc loop seq
2451# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2452#elif defined(MFC_OpenMP)
2453# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2454
2455# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2456#endif
2457# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2458 do i = 1, sys_size
2459 f_hll(i) = (s_r*f_l(i) - s_l*f_r(i) + s_l*s_r*(u_r(i) - u_l(i)))/(s_r - s_l &
2460 & + verysmall)
2461 end do
2462 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
2463 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
2464 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
2465 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
2466 end if
2467
2468 ! ADC sensor
2469 sigma_l = pres_tot_l
2470 sigma_r = pres_tot_r
2471 dsigma = sigma_r - sigma_l
2472 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
2473
2474 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
2475 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
2476 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
2477
2478 du_t = u_t_r - u_t_l
2479 dtau_nt = tau_nt_r - tau_nt_l
2480 du_t2 = u_t2_r - u_t2_l
2481 dtau_nt2 = tau_nt2_r - tau_nt2_l
2482
2483 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
2484 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
2485 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
2486 & + verysmall)
2487
2488 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
2489 phi = exp(-(sensor_combined**adc_power))
2490
2491 ! Blend all flux components: F_HLL is in physical order
2492
2493# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2494#if defined(MFC_OpenACC)
2495# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2496!$acc loop seq
2497# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2498#elif defined(MFC_OpenMP)
2499# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2500
2501# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2502#endif
2503# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2504 do i = 1, sys_size
2505 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
2506# 1503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2507 end do
2508
2509 ! Blend interface velocities (scalar HLL traces)
2510 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
2511 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
2512 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
2513
2514 ! Overwrite vel_src with blended velocities
2515 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2516# 1512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2517 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2518# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2519 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2520# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2521
2522 ! Update advection source flux with ADC-blended face-normal velocity
2523 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
2524# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2525
2526 ! Overwrite nc_iface_vel with blended velocities
2527 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2528# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2529 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2530# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2531 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2532# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2533 end if
2534 ! END HLLC-ADC
2535# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2536
2537 ! Geometrical source flux for cylindrical coordinates
2538# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2539# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2540 end do
2541 end do
2542 end do
2543
2544# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2545#if defined(MFC_OpenACC)
2546# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2547!$acc end parallel loop
2548# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2549#elif defined(MFC_OpenMP)
2550# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2551
2552# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2553!$omp end target teams loop
2554# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2555#endif
2556# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2557# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2558# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2559 else
2560# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2561 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
2562 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
2563 ! statement and private variable from the pure-fluid emission, keeping its body and directive
2564 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
2565 ! pinned it at the GPU register ceiling for every HLLC user.
2566 ! One source of truth for this kernel's private variables: both emissions of the shared body take
2567 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
2568 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
2569 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
2570# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2571# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2572# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2573# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2574# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2575# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2576# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2577# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2578# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2579# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2580# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2581# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2582# 883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2583# 885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2584# 886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2585 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
2586 ! both emissions the same name; amdflang then launches the wrong one and a
2587 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
2588 ! give two line numbers. Do not merge them back into one (still faults on AFAR 24.3).
2589# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2590
2591# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2592
2593# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2594#if defined(MFC_OpenACC)
2595# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2596!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, 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, &
2597# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2598!$acc& 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, c_sum_Yi_Phi, 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, &
2599# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2600!$acc& s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, &
2601# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2602!$acc& vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
2603# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2604#elif defined(MFC_OpenMP)
2605# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2606
2607# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2608
2609# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2610
2611# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2612!$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, &
2613# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2614!$omp& 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, &
2615# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2616!$omp& Cv_L, Cv_R, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, &
2617# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2618!$omp& pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
2619# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2620!$omp& Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
2621# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2622#endif
2623# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2624# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2625 do l = is3%beg, is3%end
2626# 898 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2627 do k = is2%beg, is2%end
2628# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2629 do j = is1%beg, is1%end
2630# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2631 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2632 rho_l = 0._wp; rho_r = 0._wp
2633 gamma_l = 0._wp; gamma_r = 0._wp
2634 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2635 qv_l = 0._wp; qv_r = 0._wp
2636 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2637
2638
2639# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2640#if defined(MFC_OpenACC)
2641# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2642!$acc loop seq
2643# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2644#elif defined(MFC_OpenMP)
2645# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2646
2647# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2648#endif
2649# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2650 do i = 1, num_fluids
2651 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2652# 910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2653 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2654# 911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2655 end do
2656
2657
2658# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2659#if defined(MFC_OpenACC)
2660# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2661!$acc loop seq
2662# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2663#elif defined(MFC_OpenMP)
2664# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2665
2666# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2667#endif
2668# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2669 do i = 1, num_dims
2670 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2671# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2672 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
2673# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2674 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2675 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2676 end do
2677
2678 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2679# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2680 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
2681# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2682
2683# 955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2684
2685 ! Change this by splitting it into the cases present in the bubbles_euler
2686 if (mpp_lim) then
2687
2688# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2689#if defined(MFC_OpenACC)
2690# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2691!$acc loop seq
2692# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2693#elif defined(MFC_OpenMP)
2694# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2695
2696# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2697#endif
2698# 959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2699 do i = 1, num_fluids
2700 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2701# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2702 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2703# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2704 & eqn_idx%E + i)), 1._wp)
2705 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
2706# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2707 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
2708# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2709 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
2710# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2711 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2712# 967 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2713 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2714# 968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2715 end do
2716
2717
2718# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2719#if defined(MFC_OpenACC)
2720# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2721!$acc loop seq
2722# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2723#elif defined(MFC_OpenMP)
2724# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2725
2726# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2727#endif
2728# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2729 do i = 1, num_fluids
2730 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2731# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2732 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2733 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
2734# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2735 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2736 end do
2737 end if
2738
2739 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
2740 ! downstream
2741
2742# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2743#if defined(MFC_OpenACC)
2744# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2745!$acc loop seq
2746# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2747#elif defined(MFC_OpenMP)
2748# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2749
2750# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2751#endif
2752# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2753 do i = 1, num_fluids
2754 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2755# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2756 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
2757# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2758 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2759# 986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2760 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2761# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2762 end do
2763
2764 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
2765 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
2766
2767 if (viscous) then
2768 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
2769 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
2770 end if
2771
2772 if (chemistry) then
2773 c_sum_yi_phi = 0.0_wp
2774
2775# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2776#if defined(MFC_OpenACC)
2777# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2778!$acc loop seq
2779# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2780#elif defined(MFC_OpenMP)
2781# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2782
2783# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2784#endif
2785# 1000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2786 do i = eqn_idx%species%beg, eqn_idx%species%end
2787 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2788# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2789 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
2790# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2791 end do
2792
2793 call get_mixture_molecular_weight(ys_l, mw_l)
2794 call get_mixture_molecular_weight(ys_r, mw_r)
2795
2796 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
2797 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
2798
2799 r_gas_l = gas_constant/mw_l
2800 r_gas_r = gas_constant/mw_r
2801
2802 t_l = pres_l/rho_l/r_gas_l
2803 t_r = pres_r/rho_r/r_gas_r
2804
2805 call get_mixture_caloric_state(t_l, ys_l, cp_il, cp_l, cv_l, e_l)
2806 call get_mixture_caloric_state(t_r, ys_r, cp_ir, cp_r, cv_r, e_r)
2807
2808 if (chem_params%gamma_method == 1) then
2809 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2810 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
2811 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
2812
2813 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
2814 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
2815 else if (chem_params%gamma_method == 2) then
2816 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2817 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
2818 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2819 end if
2820
2821 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2822 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2823 h_l = (e_l + pres_l)/rho_l
2824 h_r = (e_r + pres_r)/rho_r
2825 else
2826 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
2827 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
2828
2829 h_l = (e_l + pres_l)/rho_l
2830 h_r = (e_r + pres_r)/rho_r
2831 end if
2832
2833# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2834 h_l = (e_l + pres_l)/rho_l
2835 h_r = (e_r + pres_r)/rho_r
2836# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2837
2838 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
2839 ! average costs eight square roots per face.
2840 if (wave_speeds == wave_speeds_pressure) then
2841 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
2842 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
2843 if (chemistry .and. avg_state == avg_state_roe) then
2844 r_species(1:num_species) = gas_constant/molecular_weights
2845 call get_species_enthalpies_rt(t_l, h_il)
2846 call get_species_enthalpies_rt(t_r, h_ir)
2847 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
2848 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
2849 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
2850 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
2851 & gamma_avg, c_sum_yi_phi)
2852 end if
2853 end if
2854
2855 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
2856
2857 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
2858
2859 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
2860 ! costs eight square roots per face under the Roe average.
2861 if (wave_speeds == wave_speeds_pressure) then
2862 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
2863 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
2864 & alpha_rho_r)
2865 end if
2866
2867 if (viscous) then
2868 if (chemistry) then
2869 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2870 end if
2871
2872# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2873#if defined(MFC_OpenACC)
2874# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2875!$acc loop seq
2876# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2877#elif defined(MFC_OpenMP)
2878# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2879
2880# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2881#endif
2882# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2883 do i = 1, 2
2884 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2885# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2886 end do
2887 end if
2888
2889 ! Low Mach correction
2890 if (low_mach == 2) then
2891 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
2892 & vel_r(dir_idx(1)))
2893 end if
2894
2895 if (wave_speeds == wave_speeds_direct) then
2896# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2897 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2898 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2899 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2900 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
2901 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
2902# 1136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2903 else if (wave_speeds == wave_speeds_pressure) then
2904 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2905
2906 pres_sr = pres_sl
2907
2908 ! Low Mach correction: Thornber et al. JCP (2008)
2909 ms_l = max(1._wp, &
2910 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
2911 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
2912 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
2913 ms_r = max(1._wp, &
2914 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
2915 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
2916 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
2917
2918 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2919 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2920
2921 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2922 end if
2923
2924 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2925 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2926
2927 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2928 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2929 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2930 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
2931 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2932 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2933
2934 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2935 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2936 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2937
2938 ! Low Mach correction
2939 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
2940 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
2941
2942# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2943
2944 ! COMPUTING THE HLLC FLUXES MASS FLUX.
2945
2946# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2947#if defined(MFC_OpenACC)
2948# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2949!$acc loop seq
2950# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2951#elif defined(MFC_OpenMP)
2952# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2953
2954# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2955#endif
2956# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2957 do i = 1, eqn_idx%cont%end
2958 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2959# 1198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2960 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2961# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2962 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2963 end do
2964
2965# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2966
2967# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2968#if defined(MFC_OpenACC)
2969# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2970!$acc loop seq
2971# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2972#elif defined(MFC_OpenMP)
2973# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2974
2975# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2976#endif
2977# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2978 do i = 1, num_dims
2979 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
2980 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
2981 flux_rsx_vf(j, k, l, &
2982# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2983 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
2984 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
2985 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
2986 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2987 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
2988 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
2989 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
2990 end do
2991
2992 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
2993 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
2994 flux_rsx_vf(j, k, l, &
2995# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2996 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
2997 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
2998 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
2999 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
3000 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
3001# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3002
3003 ! VOLUME FRACTION FLUX.
3004
3005# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3006#if defined(MFC_OpenACC)
3007# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3008!$acc loop seq
3009# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3010#elif defined(MFC_OpenMP)
3011# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3012
3013# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3014#endif
3015# 1359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3016 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3017 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3018# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3019 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3020# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3021 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3022 end do
3023
3024 ! VOLUME FRACTION SOURCE FLUX.
3025
3026# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3027#if defined(MFC_OpenACC)
3028# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3029!$acc loop seq
3030# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3031#elif defined(MFC_OpenMP)
3032# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3033
3034# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3035#endif
3036# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3037 do i = 1, num_dims
3038 vel_src_rsx_vf(j, k, l, &
3039# 1369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3040 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
3041 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
3042 end do
3043
3044 ! COLOR FUNCTION FLUX
3045 if (surface_tension) then
3046 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
3047# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3048 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3049 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3050# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3051 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3052 end if
3053
3054 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3055# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3056
3057 if (chemistry) then
3058
3059# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3060#if defined(MFC_OpenACC)
3061# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3062!$acc loop seq
3063# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3064#elif defined(MFC_OpenMP)
3065# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3066
3067# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3068#endif
3069# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3070 do i = eqn_idx%species%beg, eqn_idx%species%end
3071 y_l = ql_prim_rsx_vf(j, k, l, i)
3072# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3073 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
3074# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3075
3076 flux_rsx_vf(j, k, l, &
3077# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3078 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3079 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3080 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
3081# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3082 end do
3083 end if
3084
3085# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3086
3087 ! Geometrical source flux for cylindrical coordinates
3088# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3089# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3090 end do
3091 end do
3092 end do
3093
3094# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3095#if defined(MFC_OpenACC)
3096# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3097!$acc end parallel loop
3098# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3099#elif defined(MFC_OpenMP)
3100# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3101
3102# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3103!$omp end target teams loop
3104# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3105#endif
3106# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3107# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3108 end if
3109 end if
3110# 169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3111# 170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3112# 171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3113 if (norm_dir == 2) then
3114# 172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3115 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
3116 if (model_eqns == model_eqns_6eq) then
3117 ! 6-equation model (model_eqns=3): separate phasic internal energies
3118
3119# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3120
3121# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3122#if defined(MFC_OpenACC)
3123# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3124!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, &
3125# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3126!$acc& Cp_iL, Cp_iR, R_species, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, 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, &
3127# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3128!$acc& gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_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, &
3129# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3130!$acc& alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, alpha_K_star, alpha_rho_K_star, &
3131# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3132!$acc& p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
3133# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3134#elif defined(MFC_OpenMP)
3135# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3136
3137# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3138
3139# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3140
3141# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3142!$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, &
3143# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3144!$omp& vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, &
3145# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3146!$omp& H_R, 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, rho_avg, H_avg, &
3147# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3148!$omp& 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, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, &
3149# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3150!$omp& s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, alpha_K_star, alpha_rho_K_star, p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
3151# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3152#endif
3153# 185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3154 do l = is3%beg, is3%end
3155# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3156 do k = is1%beg, is1%end
3157# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3158 do j = is2%beg, is2%end
3159# 188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3160 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3161 rho_l = 0._wp; rho_r = 0._wp
3162 gamma_l = 0._wp; gamma_r = 0._wp
3163 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3164 qv_l = 0._wp; qv_r = 0._wp
3165 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
3166
3167
3168# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3169#if defined(MFC_OpenACC)
3170# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3171!$acc loop seq
3172# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3173#elif defined(MFC_OpenMP)
3174# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3175
3176# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3177#endif
3178# 196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3179 do i = 1, num_dims
3180 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3181# 198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3182 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3183# 199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3184 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3185 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3186 end do
3187
3188 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3189# 204 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3190 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3191# 205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3192
3193 rho_l = 0._wp
3194 gamma_l = 0._wp
3195 pi_inf_l = 0._wp
3196 qv_l = 0._wp
3197
3198 rho_r = 0._wp
3199 gamma_r = 0._wp
3200 pi_inf_r = 0._wp
3201 qv_r = 0._wp
3202
3203 alpha_l_sum = 0._wp
3204 alpha_r_sum = 0._wp
3205
3206 if (mpp_lim) then
3207
3208# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3209#if defined(MFC_OpenACC)
3210# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3211!$acc loop seq
3212# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3213#elif defined(MFC_OpenMP)
3214# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3215
3216# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3217#endif
3218# 221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3219 do i = 1, num_fluids
3220 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
3221# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3222 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
3223# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3224 & eqn_idx%E + i)), 1._wp)
3225 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3226# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3227 end do
3228
3229
3230# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3231#if defined(MFC_OpenACC)
3232# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3233!$acc loop seq
3234# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3235#elif defined(MFC_OpenMP)
3236# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3237
3238# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3239#endif
3240# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3241 do i = 1, num_fluids
3242 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
3243# 231 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3244 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
3245# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3246 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
3247# 233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3248 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3249# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3250 end do
3251
3252
3253# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3254#if defined(MFC_OpenACC)
3255# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3256!$acc loop seq
3257# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3258#elif defined(MFC_OpenMP)
3259# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3260
3261# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3262#endif
3263# 237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3264 do i = 1, num_fluids
3265 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
3266# 239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3267 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
3268 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
3269# 241 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3270 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
3271 end do
3272 end if
3273
3274
3275# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3276#if defined(MFC_OpenACC)
3277# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3278!$acc loop seq
3279# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3280#elif defined(MFC_OpenMP)
3281# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3282
3283# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3284#endif
3285# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3286 do i = 1, num_fluids
3287 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3288# 248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3289 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3290# 249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3291 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
3292# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3293 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
3294# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3295 end do
3296
3297 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
3298 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
3299
3300 if (viscous) then
3301 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
3302 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
3303 end if
3304
3305 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
3306 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
3307
3308 h_l = (e_l + pres_l)/rho_l
3309 h_r = (e_r + pres_r)/rho_r
3310
3311 ! Only the Roe path writes this, and chemistry is unreachable at model_eqns = 6eq; zero it
3312 ! so the sound speed below never reads an undefined value.
3313 c_sum_yi_phi = 0._wp
3314
3315 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
3316 ! average costs eight square roots per face.
3317 if (wave_speeds == wave_speeds_pressure) then
3318 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, &
3319 & qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
3320 end if
3321
3322 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
3323
3324 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
3325
3326 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
3327 ! costs eight square roots per face under the Roe average.
3328 if (wave_speeds == wave_speeds_pressure) then
3329 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
3330 & h_avg, c_sum_yi_phi, alpha_r, c_avg, alpha_rho_r)
3331 end if
3332
3333 if (viscous) then
3334
3335# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3336#if defined(MFC_OpenACC)
3337# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3338!$acc loop seq
3339# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3340#elif defined(MFC_OpenMP)
3341# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3342
3343# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3344#endif
3345# 291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3346 do i = 1, 2
3347 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3348# 293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3349 end do
3350 end if
3351
3352 ! Low Mach correction
3353 if (low_mach == 2) then
3354 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
3355 & vel_r(dir_idx(1)))
3356 end if
3357
3358 ! COMPUTING THE DIRECT WAVE SPEEDS
3359 if (wave_speeds == wave_speeds_direct) then
3360 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3361 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3362 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3363 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3364 & - rho_r*(s_r - vel_r(dir_idx(1))))
3365 else if (wave_speeds == wave_speeds_pressure) then
3366 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3367
3368 pres_sr = pres_sl
3369
3370 ! Low Mach correction: Thornber et al. JCP (2008)
3371 ms_l = max(1._wp, &
3372 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
3373 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
3374 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
3375 ms_r = max(1._wp, &
3376 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
3377 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
3378 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
3379
3380 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3381 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3382
3383 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3384 end if
3385
3386 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3387 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3388
3389 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3390 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3391 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3392 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3393 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3394
3395 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3396 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
3397 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
3398
3399 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
3400 xi_mp = -min(0._wp, sign(1._wp, s_l))
3401 xi_pp = max(0._wp, sign(1._wp, s_r))
3402
3403 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l &
3404 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
3405 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
3406 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
3407 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
3408
3409 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
3410
3411 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + xi_mp*xi_pp*(s_s &
3412 & - vel_r(dir_idx(1)))
3413
3414 ! Low Mach correction
3415 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
3416 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
3417
3418 ! COMPUTING FLUXES MASS FLUX.
3419
3420# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3421#if defined(MFC_OpenACC)
3422# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3423!$acc loop seq
3424# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3425#elif defined(MFC_OpenMP)
3426# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3427
3428# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3429#endif
3430# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3431 do i = 1, eqn_idx%cont%end
3432 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3433# 366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3434 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3435# 367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3436 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3437 end do
3438
3439 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
3440
3441# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3442#if defined(MFC_OpenACC)
3443# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3444!$acc loop seq
3445# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3446#elif defined(MFC_OpenMP)
3447# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3448
3449# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3450#endif
3451# 372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3452 do i = 1, num_dims
3453 flux_rsx_vf(j, k, l, &
3454# 374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3455 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
3456 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
3457 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
3458 & *dir_flg(dir_idx(i))*pcorr
3459 end do
3460
3461 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3462 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
3463# 382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3464
3465 ! VOLUME FRACTION FLUX.
3466
3467# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3468#if defined(MFC_OpenACC)
3469# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3470!$acc loop seq
3471# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3472#elif defined(MFC_OpenMP)
3473# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3474
3475# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3476#endif
3477# 385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3478 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3479 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3480# 387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3481 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
3482# 388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3483 end do
3484
3485 ! Advection velocity source: interface velocity for volume fraction transport
3486
3487# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3488#if defined(MFC_OpenACC)
3489# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3490!$acc loop seq
3491# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3492#elif defined(MFC_OpenMP)
3493# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3494
3495# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3496#endif
3497# 392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3498 do i = 1, num_dims
3499 vel_src_rsx_vf(j, k, l, &
3500# 394 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3501 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3502 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
3503 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
3504 end do
3505
3506 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
3507 ! energy flux
3508
3509# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3510#if defined(MFC_OpenACC)
3511# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3512!$acc loop seq
3513# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3514#elif defined(MFC_OpenMP)
3515# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3516
3517# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3518#endif
3519# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3520 do i = 1, num_fluids
3521 ! Phasic isentrope p* from the upwind state: closed form for stiffened gas, integrated
3522 ! for a state-dependent EOS.
3523 call s_phase_pressure_on_isentrope(pres_l, alpha_rho_l(i)/max(alpha_l(i), sgm_eps), xi_l, i, &
3524 & p_isen_l)
3525 call s_phase_pressure_on_isentrope(pres_r, alpha_rho_r(i)/max(alpha_r(i), sgm_eps), xi_r, i, &
3526 & p_isen_r)
3527 p_k_star = xi_m*(xi_mp*(p_isen_l - pres_l) + pres_l) + xi_p*(xi_pp*(p_isen_r - pres_r) + pres_r)
3528
3529 alpha_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
3530# 412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3531 & i + eqn_idx%adv%beg - 1) &
3532 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3533# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3534 & i + eqn_idx%adv%beg - 1)
3535 alpha_rho_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
3536# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3537 & i + eqn_idx%cont%beg - 1) &
3538 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3539# 418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3540 & i + eqn_idx%cont%beg - 1)
3541 ! Star partial density xi_K alpha_rho, blended like p_K_Star: a state-dependent EOS reads
3542 ! its coefficients at the star density, not the upwind one.
3543 call s_phase_internal_energy(p_k_star, alpha_k_star, &
3544 & alpha_rho_k_star*(1._wp + xi_m*xi_mp*(xi_l - 1._wp) &
3545 & + xi_p*xi_pp*(xi_r - 1._wp)), i, e_k_star)
3546 flux_rsx_vf(j, k, l, &
3547# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3548 & i + eqn_idx%int_en%beg - 1) = e_k_star*vel_k_star + (s_m/s_l)*(s_p/s_r) &
3549 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
3550# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3551 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3552# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3553 & i + eqn_idx%adv%beg - 1))
3554 end do
3555
3556 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3557# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3558
3559 ! COLOR FUNCTION FLUX
3560 if (surface_tension) then
3561 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
3562# 436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3563 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
3564# 437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3565 end if
3566
3567 ! Geometrical source flux for cylindrical coordinates
3568# 441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3569 if (cyl_coord) then
3570 ! Substituting the advective flux into the inviscid geometrical source flux
3571
3572# 443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3573#if defined(MFC_OpenACC)
3574# 443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3575!$acc loop seq
3576# 443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3577#elif defined(MFC_OpenMP)
3578# 443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3579
3580# 443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3581#endif
3582# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3583 do i = 1, eqn_idx%E
3584 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3585# 446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3586 end do
3587
3588# 447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3589#if defined(MFC_OpenACC)
3590# 447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3591!$acc loop seq
3592# 447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3593#elif defined(MFC_OpenMP)
3594# 447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3595
3596# 447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3597#endif
3598# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3599 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
3600 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3601# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3602 end do
3603 ! Recalculating the radial momentum geometric source flux
3604 flux_gsrc_rsx_vf(j, k, l, &
3605# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3606 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
3607# 454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3608 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
3609 ! Geometrical source of the void fraction(s) is zero
3610
3611# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3612#if defined(MFC_OpenACC)
3613# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3614!$acc loop seq
3615# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3616#elif defined(MFC_OpenMP)
3617# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3618
3619# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3620#endif
3621# 457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3622 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3623 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
3624# 459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3625 end do
3626 end if
3627# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3628# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3629 end do
3630 end do
3631 end do
3632
3633# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3634#if defined(MFC_OpenACC)
3635# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3636!$acc end parallel loop
3637# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3638#elif defined(MFC_OpenMP)
3639# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3640
3641# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3642!$omp end target teams loop
3643# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3644#endif
3645# 479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3646 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
3647 ! 5-equation model with Euler-Euler bubble dynamics
3648
3649# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3650
3651# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3652#if defined(MFC_OpenACC)
3653# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3654!$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, alpha_rho_L, alpha_rho_R, h_avg, &
3655# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3656!$acc& gamma_avg, Re_L, Re_R, pcorr, 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, &
3657# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3658!$acc& Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, &
3659# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3660!$acc& R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR) firstprivate(Re_size_loc1, Re_size_loc2)
3661# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3662#elif defined(MFC_OpenMP)
3663# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3664
3665# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3666
3667# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3668
3669# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3670!$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, &
3671# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3672!$omp& R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, &
3673# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3674!$omp& 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, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, &
3675# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3676!$omp& s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR) &
3677# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3678!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
3679# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3680#endif
3681# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3682 do l = is3%beg, is3%end
3683# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3684 do k = is1%beg, is1%end
3685# 491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3686 do j = is2%beg, is2%end
3687# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3688 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3689 rho_l = 0._wp; rho_r = 0._wp
3690 gamma_l = 0._wp; gamma_r = 0._wp
3691 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3692 qv_l = 0._wp; qv_r = 0._wp
3693
3694
3695# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3696#if defined(MFC_OpenACC)
3697# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3698!$acc loop seq
3699# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3700#elif defined(MFC_OpenMP)
3701# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3702
3703# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3704#endif
3705# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3706 do i = 1, num_fluids
3707 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3708# 501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3709 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3710# 502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3711 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3712# 503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3713 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3714# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3715 end do
3716
3717 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3718
3719
3720# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3721#if defined(MFC_OpenACC)
3722# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3723!$acc loop seq
3724# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3725#elif defined(MFC_OpenMP)
3726# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3727
3728# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3729#endif
3730# 509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3731 do i = 1, num_dims
3732 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3733# 511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3734 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3735# 512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3736 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3737 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3738 end do
3739
3740 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
3741 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
3742
3743 if (viscous) then
3744 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
3745
3746# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3747#if defined(MFC_OpenACC)
3748# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3749!$acc loop seq
3750# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3751#elif defined(MFC_OpenMP)
3752# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3753
3754# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3755#endif
3756# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3757 do i = 1, 2
3758 re_l(i) = dflt_real
3759 re_r(i) = dflt_real
3760
3761 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
3762 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
3763
3764
3765# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3766#if defined(MFC_OpenACC)
3767# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3768!$acc loop seq
3769# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3770#elif defined(MFC_OpenMP)
3771# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3772
3773# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3774#endif
3775# 530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3776 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
3777 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
3778# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3779 & q)))/res_gs(i, q) + re_l(i)
3780 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
3781# 534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3782 & q)))/res_gs(i, q) + re_r(i)
3783 end do
3784
3785 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3786 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3787 end do
3788 end if
3789 end if
3790
3791 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3792# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3793 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3794# 545 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3795
3796 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
3797 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
3798
3799 h_l = (e_l + pres_l)/rho_l
3800 h_r = (e_r + pres_r)/rho_r
3801
3802 if (avg_state == avg_state_arithmetic) then
3803
3804# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3805#if defined(MFC_OpenACC)
3806# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3807!$acc loop seq
3808# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3809#elif defined(MFC_OpenMP)
3810# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3811
3812# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3813#endif
3814# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3815 do i = 1, nb
3816 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
3817# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3818 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
3819# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3820
3821 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
3822# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3823 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
3824# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3825 if (.not. polytropic .and. .not. qbmm) then
3826 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
3827# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3828 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
3829# 563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3830 end if
3831 end do
3832
3833 if (.not. qbmm) then
3834 if (adv_n) then
3835 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
3836# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3837 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
3838# 570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3839 else
3840 nbub_l = 0._wp
3841 nbub_r = 0._wp
3842
3843# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3844#if defined(MFC_OpenACC)
3845# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3846!$acc loop seq
3847# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3848#elif defined(MFC_OpenMP)
3849# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3850
3851# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3852#endif
3853# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3854 do i = 1, nb
3855 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
3856 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
3857 end do
3858
3859 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
3860# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3861 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
3862# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3863 & eqn_idx%E + num_fluids)/nbub_r
3864 end if
3865 else
3866 ! nb stored in 0th moment of first R0 bin in variable conversion module
3867 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
3868# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3869 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
3870# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3871 end if
3872
3873
3874# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3875#if defined(MFC_OpenACC)
3876# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3877!$acc loop seq
3878# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3879#elif defined(MFC_OpenMP)
3880# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3881
3882# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3883#endif
3884# 590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3885 do i = 1, nb
3886 if (.not. qbmm) then
3887 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
3888 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
3889 end if
3890 end do
3891
3892 if (qbmm) then
3893 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
3894# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3895 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
3896# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3897
3898 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
3899# 602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3900 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
3901# 603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3902
3903 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
3904# 605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3905 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
3906# 606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3907 else
3908 pbwr3lbar = 0._wp
3909 pbwr3rbar = 0._wp
3910
3911 r3lbar = 0._wp
3912 r3rbar = 0._wp
3913
3914 r3v2lbar = 0._wp
3915 r3v2rbar = 0._wp
3916
3917
3918# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3919#if defined(MFC_OpenACC)
3920# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3921!$acc loop seq
3922# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3923#elif defined(MFC_OpenMP)
3924# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3925
3926# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3927#endif
3928# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3929 do i = 1, nb
3930 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
3931 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
3932
3933 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
3934 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
3935
3936 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
3937 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
3938 end do
3939 end if
3940
3941 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3942 h_avg = 5.e-1_wp*(h_l + h_r)
3943 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3944 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3945 vel_avg_rms = 0._wp
3946
3947
3948# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3949#if defined(MFC_OpenACC)
3950# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3951!$acc loop seq
3952# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3953#elif defined(MFC_OpenMP)
3954# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3955
3956# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3957#endif
3958# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3959 do i = 1, num_dims
3960 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3961 end do
3962 end if
3963
3964 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
3965
3966 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
3967
3968 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
3969 ! costs eight square roots per face under the Roe average.
3970 if (wave_speeds == wave_speeds_pressure) then
3971 ! Zero, not c_sum_Yi_Phi: this loop never forms the chemistry average, and
3972 ! chemistry with bubbles_euler/qbmm is prohibited, so the branch is unreachable.
3973 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
3974 & h_avg, 0._wp, alpha_r, c_avg, alpha_rho_r)
3975 end if
3976
3977 if (viscous) then
3978
3979# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3980#if defined(MFC_OpenACC)
3981# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3982!$acc loop seq
3983# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3984#elif defined(MFC_OpenMP)
3985# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3986
3987# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3988#endif
3989# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3990 do i = 1, 2
3991 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3992# 658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3993 end do
3994 end if
3995
3996 ! Low Mach correction
3997 if (low_mach == 2) then
3998 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
3999 & vel_r(dir_idx(1)))
4000 end if
4001
4002 if (wave_speeds == wave_speeds_direct) then
4003 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
4004 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
4005
4006 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
4007 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
4008 & - rho_r*(s_r - vel_r(dir_idx(1))))
4009 else if (wave_speeds == wave_speeds_pressure) then
4010 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4011
4012 pres_sr = pres_sl
4013
4014 ! Low Mach correction: Thornber et al. JCP (2008)
4015 ms_l = max(1._wp, &
4016 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
4017 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
4018 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
4019 ms_r = max(1._wp, &
4020 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
4021 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
4022 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
4023
4024 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4025 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4026
4027 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4028 end if
4029
4030 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4031 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4032
4033 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4034 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4035 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4036 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4037 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4038
4039 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4040 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4041 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4042
4043 ! Low Mach correction
4044 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
4045 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
4046
4047
4048# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4049#if defined(MFC_OpenACC)
4050# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4051!$acc loop seq
4052# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4053#elif defined(MFC_OpenMP)
4054# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4055
4056# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4057#endif
4058# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4059 do i = 1, eqn_idx%cont%end
4060 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4061# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4062 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4063# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4064 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4065 end do
4066
4067 if (bubbles_euler .and. (num_fluids > 1)) then
4068 ! Kill mass transport @ gas density
4069 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
4070# 722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4071 end if
4072
4073 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4074
4075 ! Include p_tilde
4076
4077 if (avg_state == avg_state_arithmetic) then
4078 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
4079 pres_l = pres_l - alpha_l(num_fluids)*pres_l
4080 else
4081 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
4082 end if
4083
4084 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
4085 pres_r = pres_r - alpha_r(num_fluids)*pres_r
4086 else
4087 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
4088 end if
4089 end if
4090
4091
4092# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4093#if defined(MFC_OpenACC)
4094# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4095!$acc loop seq
4096# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4097#elif defined(MFC_OpenMP)
4098# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4099
4100# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4101#endif
4102# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4103 do i = 1, num_dims
4104 flux_rsx_vf(j, k, l, &
4105# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4106 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
4107 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4108 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
4109 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4110 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4111 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
4112 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
4113 end do
4114
4115 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
4116 flux_rsx_vf(j, k, l, &
4117# 756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4118 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
4119 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
4120 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
4121 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
4122 & *pcorr*s_s
4123
4124 ! Volume fraction flux
4125
4126# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4127#if defined(MFC_OpenACC)
4128# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4129!$acc loop seq
4130# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4131#elif defined(MFC_OpenMP)
4132# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4133
4134# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4135#endif
4136# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4137 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4138 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4139# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4140 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4141# 767 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4142 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4143 end do
4144
4145 ! Advection velocity source: interface velocity for volume fraction transport
4146
4147# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4148#if defined(MFC_OpenACC)
4149# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4150!$acc loop seq
4151# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4152#elif defined(MFC_OpenMP)
4153# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4154
4155# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4156#endif
4157# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4158 do i = 1, num_dims
4159 vel_src_rsx_vf(j, k, l, &
4160# 774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4161 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
4162 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
4163 end do
4164
4165 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4166# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4167
4168 ! Add advection flux for bubble variables
4169
4170# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4171#if defined(MFC_OpenACC)
4172# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4173!$acc loop seq
4174# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4175#elif defined(MFC_OpenMP)
4176# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4177
4178# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4179#endif
4180# 782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4181 do i = eqn_idx%bub%beg, eqn_idx%bub%end
4182 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
4183# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4184 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4185 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4186# 786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4187 end do
4188
4189 if (qbmm) then
4190 flux_rsx_vf(j, k, l, &
4191# 790 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4192 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4193 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4194 end if
4195
4196 if (adv_n) then
4197 flux_rsx_vf(j, k, l, &
4198# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4199 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4200 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4201 end if
4202
4203 ! Geometrical source flux for cylindrical coordinates
4204# 802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4205 if (cyl_coord) then
4206 ! Substituting the advective flux into the inviscid geometrical source flux
4207
4208# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4209#if defined(MFC_OpenACC)
4210# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4211!$acc loop seq
4212# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4213#elif defined(MFC_OpenMP)
4214# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4215
4216# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4217#endif
4218# 805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4219 do i = 1, eqn_idx%E
4220 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4221# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4222 end do
4223 ! Recalculating the radial momentum geometric source flux
4224 flux_gsrc_rsx_vf(j, k, l, &
4225# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4226 & eqn_idx%cont%end + dir_idx(1)) &
4227 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l(dir_idx(1)), &
4228 & vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, &
4229 & dir_flg(dir_idx(1)))
4230 ! Geometrical source of the void fraction(s) is zero
4231
4232# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4233#if defined(MFC_OpenACC)
4234# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4235!$acc loop seq
4236# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4237#elif defined(MFC_OpenMP)
4238# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4239
4240# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4241#endif
4242# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4243 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4244 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4245# 818 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4246 end do
4247 end if
4248# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4249# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4250 end do
4251 end do
4252 end do
4253
4254# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4255#if defined(MFC_OpenACC)
4256# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4257!$acc end parallel loop
4258# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4259#elif defined(MFC_OpenMP)
4260# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4261
4262# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4263!$omp end target teams loop
4264# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4265#endif
4266# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4267# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4268# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4269 else if (hypoelasticity) then
4270# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4271 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
4272 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
4273 ! statement and private variable from the pure-fluid emission, keeping its body and directive
4274 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
4275 ! pinned it at the GPU register ceiling for every HLLC user.
4276 ! One source of truth for this kernel's private variables: both emissions of the shared body take
4277 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
4278 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
4279 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
4280# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4281# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4282# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4283# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4284# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4285# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4286# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4287# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4288# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4289# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4290# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4291# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4292# 879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4293# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4294# 886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4295 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
4296 ! both emissions the same name; amdflang then launches the wrong one and a
4297 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
4298 ! give two line numbers. Do not merge them back into one (still faults on AFAR 24.3).
4299# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4300
4301# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4302
4303# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4304#if defined(MFC_OpenACC)
4305# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4306!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, 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, &
4307# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4308!$acc& 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, c_sum_Yi_Phi, 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, &
4309# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4310!$acc& s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, &
4311# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4312!$acc& vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR, ptilde_L, ptilde_R, tau_e_L, tau_e_R, G_L, G_R, damage_L, damage_R, solid_partial_density_L, &
4313# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4314!$acc& solid_partial_density_R, U_L, U_R, F_L, F_R, F_star_L, F_star_R, F_HLLC, u_n_HLLC, u_t_HLLC, u_t2_HLLC, pres_tot_L, pres_tot_R, u_n_L, u_n_R, u_t_L, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nn_R, &
4315# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4316!$acc& tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, p_face, tau_qq_face, A_L, A_R, denom_A, u_t_star, tau_nt_star, &
4317# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4318!$acc& u_t2_star, tau_nt2_star, pres_tot_star, F_HLL, u_n_HLL_trace, u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, &
4319# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4320!$acc& a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
4321# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4322#elif defined(MFC_OpenMP)
4323# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4324
4325# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4326
4327# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4328
4329# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4330!$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, &
4331# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4332!$omp& 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, &
4333# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4334!$omp& Cv_L, Cv_R, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, &
4335# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4336!$omp& pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
4337# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4338!$omp& Cp_iR, R_species, h_iL, h_iR, ptilde_L, ptilde_R, tau_e_L, tau_e_R, G_L, G_R, damage_L, damage_R, solid_partial_density_L, solid_partial_density_R, U_L, U_R, F_L, F_R, F_star_L, F_star_R, &
4339# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4340!$omp& F_HLLC, u_n_HLLC, u_t_HLLC, u_t2_HLLC, pres_tot_L, pres_tot_R, u_n_L, u_n_R, u_t_L, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nn_R, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, tau_nt2_L, tau_nt2_R, &
4341# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4342!$omp& tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, p_face, tau_qq_face, A_L, A_R, denom_A, u_t_star, tau_nt_star, u_t2_star, tau_nt2_star, pres_tot_star, F_HLL, u_n_HLL_trace, &
4343# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4344!$omp& u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, &
4345# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4346!$omp& sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
4347# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4348#endif
4349# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4350# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4351 do l = is3%beg, is3%end
4352# 898 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4353 do k = is1%beg, is1%end
4354# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4355 do j = is2%beg, is2%end
4356# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4357 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4358 rho_l = 0._wp; rho_r = 0._wp
4359 gamma_l = 0._wp; gamma_r = 0._wp
4360 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4361 qv_l = 0._wp; qv_r = 0._wp
4362 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
4363
4364
4365# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4366#if defined(MFC_OpenACC)
4367# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4368!$acc loop seq
4369# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4370#elif defined(MFC_OpenMP)
4371# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4372
4373# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4374#endif
4375# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4376 do i = 1, num_fluids
4377 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4378# 910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4379 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4380# 911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4381 end do
4382
4383
4384# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4385#if defined(MFC_OpenACC)
4386# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4387!$acc loop seq
4388# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4389#elif defined(MFC_OpenMP)
4390# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4391
4392# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4393#endif
4394# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4395 do i = 1, num_dims
4396 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4397# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4398 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4399# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4400 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4401 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4402 end do
4403
4404 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4405# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4406 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4407# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4408
4409# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4410
4411# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4412#if defined(MFC_OpenACC)
4413# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4414!$acc loop seq
4415# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4416#elif defined(MFC_OpenMP)
4417# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4418
4419# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4420#endif
4421# 926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4422 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4423 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4424# 928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4425 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4426# 929 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4427 end do
4428
4429 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
4430 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
4431 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
4432 if (n > 0) then
4433 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
4434 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
4435 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
4436 end if
4437 if (p > 0) then
4438 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
4439 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
4440 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
4441 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
4442 end if
4443 pres_tot_l = pres_l - tau_nn_l
4444 pres_tot_r = pres_r - tau_nn_r
4445 if (cyl_coord) then
4446 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4447 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4448 else
4449 tau_qq_l = 0._wp
4450 tau_qq_r = 0._wp
4451 end if
4452# 955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4453
4454 ! Change this by splitting it into the cases present in the bubbles_euler
4455 if (mpp_lim) then
4456
4457# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4458#if defined(MFC_OpenACC)
4459# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4460!$acc loop seq
4461# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4462#elif defined(MFC_OpenMP)
4463# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4464
4465# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4466#endif
4467# 959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4468 do i = 1, num_fluids
4469 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
4470# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4471 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
4472# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4473 & eqn_idx%E + i)), 1._wp)
4474 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
4475# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4476 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
4477# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4478 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
4479# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4480 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4481# 967 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4482 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4483# 968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4484 end do
4485
4486
4487# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4488#if defined(MFC_OpenACC)
4489# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4490!$acc loop seq
4491# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4492#elif defined(MFC_OpenMP)
4493# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4494
4495# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4496#endif
4497# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4498 do i = 1, num_fluids
4499 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
4500# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4501 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
4502 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
4503# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4504 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
4505 end do
4506 end if
4507
4508 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
4509 ! downstream
4510
4511# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4512#if defined(MFC_OpenACC)
4513# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4514!$acc loop seq
4515# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4516#elif defined(MFC_OpenMP)
4517# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4518
4519# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4520#endif
4521# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4522 do i = 1, num_fluids
4523 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4524# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4525 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4526# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4527 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4528# 986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4529 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4530# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4531 end do
4532
4533 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
4534 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
4535
4536 if (viscous) then
4537 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
4538 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
4539 end if
4540
4541 if (chemistry) then
4542 c_sum_yi_phi = 0.0_wp
4543
4544# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4545#if defined(MFC_OpenACC)
4546# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4547!$acc loop seq
4548# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4549#elif defined(MFC_OpenMP)
4550# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4551
4552# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4553#endif
4554# 1000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4555 do i = eqn_idx%species%beg, eqn_idx%species%end
4556 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
4557# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4558 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
4559# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4560 end do
4561
4562 call get_mixture_molecular_weight(ys_l, mw_l)
4563 call get_mixture_molecular_weight(ys_r, mw_r)
4564
4565 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
4566 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
4567
4568 r_gas_l = gas_constant/mw_l
4569 r_gas_r = gas_constant/mw_r
4570
4571 t_l = pres_l/rho_l/r_gas_l
4572 t_r = pres_r/rho_r/r_gas_r
4573
4574 call get_mixture_caloric_state(t_l, ys_l, cp_il, cp_l, cv_l, e_l)
4575 call get_mixture_caloric_state(t_r, ys_r, cp_ir, cp_r, cv_r, e_r)
4576
4577 if (chem_params%gamma_method == 1) then
4578 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4579 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
4580 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
4581
4582 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
4583 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
4584 else if (chem_params%gamma_method == 2) then
4585 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4586 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
4587 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4588 end if
4589
4590 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4591 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4592 h_l = (e_l + pres_l)/rho_l
4593 h_r = (e_r + pres_r)/rho_r
4594 else
4595 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
4596 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
4597
4598 h_l = (e_l + pres_l)/rho_l
4599 h_r = (e_r + pres_r)/rho_r
4600 end if
4601
4602# 1046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4603 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
4604
4605# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4606#if defined(MFC_OpenACC)
4607# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4608!$acc loop seq
4609# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4610#elif defined(MFC_OpenMP)
4611# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4612
4613# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4614#endif
4615# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4616 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4617 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4618# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4619 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4620# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4621 end do
4622 damage_l = 0._wp; damage_r = 0._wp
4623 if (cont_damage) then
4624 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
4625# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4626 damage_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%damage)
4627# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4628 end if
4629
4630 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
4631 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
4632 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
4633 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
4634 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
4635 ! keep their pre-adjustment values here.
4636# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4637
4638 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
4639 ! average costs eight square roots per face.
4640 if (wave_speeds == wave_speeds_pressure) then
4641 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
4642 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
4643 if (chemistry .and. avg_state == avg_state_roe) then
4644 r_species(1:num_species) = gas_constant/molecular_weights
4645 call get_species_enthalpies_rt(t_l, h_il)
4646 call get_species_enthalpies_rt(t_r, h_ir)
4647 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
4648 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
4649 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
4650 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
4651 & gamma_avg, c_sum_yi_phi)
4652 end if
4653 end if
4654
4655 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
4656
4657 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
4658
4659 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
4660 ! costs eight square roots per face under the Roe average.
4661 if (wave_speeds == wave_speeds_pressure) then
4662 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
4663 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
4664 & alpha_rho_r)
4665 end if
4666
4667 if (viscous) then
4668 if (chemistry) then
4669 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
4670 end if
4671
4672# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4673#if defined(MFC_OpenACC)
4674# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4675!$acc loop seq
4676# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4677#elif defined(MFC_OpenMP)
4678# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4679
4680# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4681#endif
4682# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4683 do i = 1, 2
4684 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
4685# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4686 end do
4687 end if
4688
4689 ! Low Mach correction
4690 if (low_mach == 2) then
4691 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
4692 & vel_r(dir_idx(1)))
4693 end if
4694
4695 if (wave_speeds == wave_speeds_direct) then
4696# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4697 ! Elastic wave speed, Rodriguez et al. JCP (2019)
4698 s_l = min(vel_l(dir_idx(1)) - f_elastic_signal_speed(c_l, g_l, &
4699 & tau_e_l(dir_idx_tau(1)), rho_l), &
4700 & vel_r(dir_idx(1)) - f_elastic_signal_speed(c_r, g_r, &
4701 & tau_e_r(dir_idx_tau(1)), rho_r))
4702 s_r = max(vel_r(dir_idx(1)) + f_elastic_signal_speed(c_r, g_r, &
4703 & tau_e_r(dir_idx_tau(1)), rho_r), &
4704 & vel_l(dir_idx(1)) + f_elastic_signal_speed(c_l, g_l, &
4705 & tau_e_l(dir_idx_tau(1)), rho_l))
4706 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
4707 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
4708 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
4709 & - vel_r(dir_idx(1))))
4710# 1136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4711 else if (wave_speeds == wave_speeds_pressure) then
4712 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4713
4714 pres_sr = pres_sl
4715
4716 ! Low Mach correction: Thornber et al. JCP (2008)
4717 ms_l = max(1._wp, &
4718 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
4719 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
4720 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
4721 ms_r = max(1._wp, &
4722 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
4723 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
4724 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
4725
4726 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4727 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4728
4729 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4730 end if
4731
4732 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4733 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4734
4735 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4736 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4737 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4738 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
4739 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4740 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4741
4742 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4743 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4744 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4745
4746 ! Low Mach correction
4747 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
4748 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
4749
4750# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4751 if (n == 0) then
4752 u_t_l = 0._wp; u_t_r = 0._wp
4753 tau_nt_l = 0._wp; tau_nt_r = 0._wp
4754 end if
4755 if (p == 0) then
4756 u_t2_l = 0._wp; u_t2_r = 0._wp
4757 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
4758 end if
4759 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
4760 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
4761 denom_a = a_r - a_l
4762 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
4763 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
4764 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
4765 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
4766 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
4767# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4768
4769 ! COMPUTING THE HLLC FLUXES MASS FLUX.
4770
4771# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4772#if defined(MFC_OpenACC)
4773# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4774!$acc loop seq
4775# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4776#elif defined(MFC_OpenMP)
4777# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4778
4779# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4780#endif
4781# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4782 do i = 1, eqn_idx%cont%end
4783 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4784# 1198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4785 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4786# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4787 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4788 end do
4789
4790# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4791 flux_rsx_vf(j, k, l, &
4792# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4793 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
4794 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
4795 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
4796 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
4797 if (n > 0) then
4798 flux_rsx_vf(j, k, l, &
4799# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4800 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
4801 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
4802 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
4803 & - tau_nt_r)
4804 end if
4805 if (p > 0) then
4806 flux_rsx_vf(j, k, l, &
4807# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4808 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
4809 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
4810 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
4811 & - tau_nt2_r)
4812 end if
4813
4814 flux_rsx_vf(j, k, l, &
4815# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4816 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
4817 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
4818 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
4819 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
4820 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
4821 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
4822 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
4823 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
4824 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
4825 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
4826
4827 if (n == 0) then
4828 flux_rsx_vf(j, k, l, &
4829# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4830 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
4831 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
4832 & + s_p*(xi_r - 1._wp))
4833 else if (p == 0) then
4834 if (dir_idx(1) == 1) then
4835 flux_rsx_vf(j, k, l, &
4836# 1243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4837 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
4838 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
4839 & + s_p*(xi_r - 1._wp))
4840 flux_rsx_vf(j, k, l, &
4841# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4842 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
4843 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
4844 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
4845 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
4846 flux_rsx_vf(j, k, l, &
4847# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4848 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
4849 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
4850 & + s_p*(xi_r - 1._wp))
4851 else
4852 flux_rsx_vf(j, k, l, &
4853# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4854 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
4855 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
4856 & + s_p*(xi_r - 1._wp))
4857 flux_rsx_vf(j, k, l, &
4858# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4859 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
4860 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
4861 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
4862 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
4863 flux_rsx_vf(j, k, l, &
4864# 1266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4865 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
4866 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
4867 & + s_p*(xi_r - 1._wp))
4868 end if
4869 else
4870 flux_rsx_vf(j, k, l, &
4871# 1272 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4872 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
4873 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4874 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4875 flux_rsx_vf(j, k, l, &
4876# 1276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4877 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
4878 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
4879 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
4880 & - rho_r*tau_nt_r))
4881 flux_rsx_vf(j, k, l, &
4882# 1281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4883 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
4884 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
4885 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
4886 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
4887 flux_rsx_vf(j, k, l, &
4888# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4889 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
4890 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4891 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4892 flux_rsx_vf(j, k, l, &
4893# 1290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4894 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
4895 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4896 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4897 flux_rsx_vf(j, k, l, &
4898# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4899 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
4900 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4901 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4902 end if
4903 if (cyl_coord) then
4904 flux_rsx_vf(j, k, l, &
4905# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4906 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
4907 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
4908 & + s_p*(xi_r - 1._wp))
4909 end if
4910
4911 ! Damage flux: U_D = m_s*D (damageable-solid partial mass)
4912 if (cont_damage) then
4913 solid_partial_density_l = 0._wp; solid_partial_density_r = 0._wp
4914
4915# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4916#if defined(MFC_OpenACC)
4917# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4918!$acc loop seq
4919# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4920#elif defined(MFC_OpenMP)
4921# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4922
4923# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4924#endif
4925# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4926 do i = 1, num_fluids
4927 if (gs_rs(i) > verysmall) then
4928 solid_partial_density_l = solid_partial_density_l + alpha_rho_l(i)
4929 solid_partial_density_r = solid_partial_density_r + alpha_rho_r(i)
4930 end if
4931 end do
4932 flux_rsx_vf(j, k, l, &
4933# 1316 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4934 & eqn_idx%damage) &
4935 & = xi_m*solid_partial_density_l*damage_l*(vel_l(dir_idx(1)) + s_m*(xi_l &
4936 & - 1._wp)) + xi_p*solid_partial_density_r*damage_r*(vel_r(dir_idx(1)) &
4937 & + s_p*(xi_r - 1._wp))
4938 end if
4939
4940 if (s_l >= 0._wp) then
4941 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
4942 else if (s_r <= 0._wp) then
4943 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
4944 else
4945 u_n_hllc = s_s*(xi_m*xi_l + xi_p*xi_r); u_t_hllc = u_t_star; u_t2_hllc = u_t2_star
4946 end if
4947 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
4948# 1330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4949 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
4950# 1331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4951 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
4952# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4953# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4954
4955 ! VOLUME FRACTION FLUX.
4956
4957# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4958#if defined(MFC_OpenACC)
4959# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4960!$acc loop seq
4961# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4962#elif defined(MFC_OpenMP)
4963# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4964
4965# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4966#endif
4967# 1359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4968 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4969 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4970# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4971 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4972# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4973 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4974 end do
4975
4976 ! VOLUME FRACTION SOURCE FLUX.
4977
4978# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4979#if defined(MFC_OpenACC)
4980# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4981!$acc loop seq
4982# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4983#elif defined(MFC_OpenMP)
4984# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4985
4986# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4987#endif
4988# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4989 do i = 1, num_dims
4990 vel_src_rsx_vf(j, k, l, &
4991# 1369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4992 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
4993 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
4994 end do
4995
4996 ! COLOR FUNCTION FLUX
4997 if (surface_tension) then
4998 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
4999# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5000 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5001 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5002# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5003 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5004 end if
5005
5006 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5007# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5008
5009 if (chemistry) then
5010
5011# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5012#if defined(MFC_OpenACC)
5013# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5014!$acc loop seq
5015# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5016#elif defined(MFC_OpenMP)
5017# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5018
5019# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5020#endif
5021# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5022 do i = eqn_idx%species%beg, eqn_idx%species%end
5023 y_l = ql_prim_rsx_vf(j, k, l, i)
5024# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5025 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5026# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5027
5028 flux_rsx_vf(j, k, l, &
5029# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5030 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5031 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5032 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
5033# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5034 end do
5035 end if
5036
5037# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5038 ! HLLC-ADC blending for hypoelasticity
5039 if (riemann_hypo_adc) then
5040 ! Build U_L, U_R and F_L, F_R in local-basis layout
5041
5042# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5043#if defined(MFC_OpenACC)
5044# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5045!$acc loop seq
5046# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5047#elif defined(MFC_OpenMP)
5048# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5049
5050# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5051#endif
5052# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5053 do i = 1, num_fluids
5054 u_l(i) = alpha_rho_l(i)
5055 u_r(i) = alpha_rho_r(i)
5056 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
5057 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
5058 f_l(i) = alpha_rho_l(i)*u_n_l
5059 f_r(i) = alpha_rho_r(i)*u_n_r
5060 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
5061 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
5062 end do
5063
5064 ! Momentum U/F in physical order via dir_idx
5065 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
5066 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
5067 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
5068 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
5069 if (n > 0) then
5070 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
5071 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
5072 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
5073 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
5074 end if
5075 if (p > 0) then
5076 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
5077 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
5078 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
5079 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
5080 end if
5081
5082 u_l(eqn_idx%E) = e_l
5083 u_r(eqn_idx%E) = e_r
5084 f_l(eqn_idx%E) = (e_l + pres_tot_l)*u_n_l - u_t_l*tau_nt_l - u_t2_l*tau_nt2_l
5085 f_r(eqn_idx%E) = (e_r + pres_tot_r)*u_n_r - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r
5086
5087 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
5088
5089# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5090#if defined(MFC_OpenACC)
5091# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5092!$acc loop seq
5093# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5094#elif defined(MFC_OpenMP)
5095# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5096
5097# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5098#endif
5099# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5100 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
5101 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
5102 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
5103 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
5104 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
5105 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
5106 end do
5107 if (cyl_coord) then
5108 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
5109 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
5110 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
5111 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
5112 end if
5113
5114 ! Compute F_HLL (physical order) and HLL trace velocities
5115 if (s_l >= 0._wp) then
5116
5117# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5118#if defined(MFC_OpenACC)
5119# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5120!$acc loop seq
5121# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5122#elif defined(MFC_OpenMP)
5123# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5124
5125# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5126#endif
5127# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5128 do i = 1, sys_size
5129 f_hll(i) = f_l(i)
5130 end do
5131 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
5132 else if (s_r <= 0._wp) then
5133
5134# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5135#if defined(MFC_OpenACC)
5136# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5137!$acc loop seq
5138# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5139#elif defined(MFC_OpenMP)
5140# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5141
5142# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5143#endif
5144# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5145 do i = 1, sys_size
5146 f_hll(i) = f_r(i)
5147 end do
5148 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
5149 else
5150
5151# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5152#if defined(MFC_OpenACC)
5153# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5154!$acc loop seq
5155# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5156#elif defined(MFC_OpenMP)
5157# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5158
5159# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5160#endif
5161# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5162 do i = 1, sys_size
5163 f_hll(i) = (s_r*f_l(i) - s_l*f_r(i) + s_l*s_r*(u_r(i) - u_l(i)))/(s_r - s_l &
5164 & + verysmall)
5165 end do
5166 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
5167 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
5168 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
5169 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
5170 end if
5171
5172 ! ADC sensor
5173 sigma_l = pres_tot_l
5174 sigma_r = pres_tot_r
5175 dsigma = sigma_r - sigma_l
5176 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
5177
5178 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
5179 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
5180 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
5181
5182 du_t = u_t_r - u_t_l
5183 dtau_nt = tau_nt_r - tau_nt_l
5184 du_t2 = u_t2_r - u_t2_l
5185 dtau_nt2 = tau_nt2_r - tau_nt2_l
5186
5187 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
5188 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
5189 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
5190 & + verysmall)
5191
5192 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
5193 phi = exp(-(sensor_combined**adc_power))
5194
5195 ! Blend all flux components: F_HLL is in physical order
5196
5197# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5198#if defined(MFC_OpenACC)
5199# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5200!$acc loop seq
5201# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5202#elif defined(MFC_OpenMP)
5203# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5204
5205# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5206#endif
5207# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5208 do i = 1, sys_size
5209 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
5210# 1503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5211 end do
5212
5213 ! Blend interface velocities (scalar HLL traces)
5214 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
5215 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
5216 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
5217
5218 ! Overwrite vel_src with blended velocities
5219 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
5220# 1512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5221 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
5222# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5223 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
5224# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5225
5226 ! Update advection source flux with ADC-blended face-normal velocity
5227 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
5228# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5229
5230 ! Overwrite nc_iface_vel with blended velocities
5231 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
5232# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5233 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
5234# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5235 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
5236# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5237 end if
5238 ! END HLLC-ADC
5239# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5240
5241 ! Geometrical source flux for cylindrical coordinates
5242# 1528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5243# 1529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5244 if (cyl_coord) then
5245
5246# 1530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5247#if defined(MFC_OpenACC)
5248# 1530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5249!$acc loop seq
5250# 1530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5251#elif defined(MFC_OpenMP)
5252# 1530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5253
5254# 1530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5255#endif
5256# 1531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5257 do i = 1, sys_size
5258 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5259# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5260 end do
5261 if (s_l >= 0._wp) then
5262 p_face = pres_l; tau_qq_face = tau_qq_l
5263 else if (s_r <= 0._wp) then
5264 p_face = pres_r; tau_qq_face = tau_qq_r
5265 else if (s_s >= 0._wp) then
5266 p_face = pres_tot_star + tau_nn_l; tau_qq_face = tau_qq_l
5267 else
5268 p_face = pres_tot_star + tau_nn_r; tau_qq_face = tau_qq_r
5269 end if
5270 flux_gsrc_rsx_vf(j, k, l, &
5271# 1544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5272 & eqn_idx%cont%end + dir_idx(1)) = flux_rsx_vf(j, k, l, &
5273# 1545 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5274 & eqn_idx%cont%end + dir_idx(1)) - p_face + tau_qq_face
5275
5276# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5277#if defined(MFC_OpenACC)
5278# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5279!$acc loop seq
5280# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5281#elif defined(MFC_OpenMP)
5282# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5283
5284# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5285#endif
5286# 1547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5287 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5288 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5289# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5290 end do
5291 end if
5292# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5293# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5294# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5295 end do
5296 end do
5297 end do
5298
5299# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5300#if defined(MFC_OpenACC)
5301# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5302!$acc end parallel loop
5303# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5304#elif defined(MFC_OpenMP)
5305# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5306
5307# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5308!$omp end target teams loop
5309# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5310#endif
5311# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5312# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5313# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5314 else
5315# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5316 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
5317 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
5318 ! statement and private variable from the pure-fluid emission, keeping its body and directive
5319 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
5320 ! pinned it at the GPU register ceiling for every HLLC user.
5321 ! One source of truth for this kernel's private variables: both emissions of the shared body take
5322 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
5323 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
5324 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
5325# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5326# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5327# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5328# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5329# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5330# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5331# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5332# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5333# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5334# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5335# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5336# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5337# 883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5338# 885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5339# 886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5340 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
5341 ! both emissions the same name; amdflang then launches the wrong one and a
5342 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
5343 ! give two line numbers. Do not merge them back into one (still faults on AFAR 24.3).
5344# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5345
5346# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5347
5348# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5349#if defined(MFC_OpenACC)
5350# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5351!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, 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, &
5352# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5353!$acc& 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, c_sum_Yi_Phi, 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, &
5354# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5355!$acc& s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, &
5356# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5357!$acc& vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
5358# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5359#elif defined(MFC_OpenMP)
5360# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5361
5362# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5363
5364# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5365
5366# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5367!$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, &
5368# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5369!$omp& 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, &
5370# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5371!$omp& Cv_L, Cv_R, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, &
5372# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5373!$omp& pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
5374# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5375!$omp& Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
5376# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5377#endif
5378# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5379# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5380 do l = is3%beg, is3%end
5381# 898 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5382 do k = is1%beg, is1%end
5383# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5384 do j = is2%beg, is2%end
5385# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5386 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5387 rho_l = 0._wp; rho_r = 0._wp
5388 gamma_l = 0._wp; gamma_r = 0._wp
5389 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5390 qv_l = 0._wp; qv_r = 0._wp
5391 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
5392
5393
5394# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5395#if defined(MFC_OpenACC)
5396# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5397!$acc loop seq
5398# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5399#elif defined(MFC_OpenMP)
5400# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5401
5402# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5403#endif
5404# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5405 do i = 1, num_fluids
5406 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5407# 910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5408 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5409# 911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5410 end do
5411
5412
5413# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5414#if defined(MFC_OpenACC)
5415# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5416!$acc loop seq
5417# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5418#elif defined(MFC_OpenMP)
5419# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5420
5421# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5422#endif
5423# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5424 do i = 1, num_dims
5425 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5426# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5427 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
5428# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5429 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5430 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5431 end do
5432
5433 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5434# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5435 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
5436# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5437
5438# 955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5439
5440 ! Change this by splitting it into the cases present in the bubbles_euler
5441 if (mpp_lim) then
5442
5443# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5444#if defined(MFC_OpenACC)
5445# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5446!$acc loop seq
5447# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5448#elif defined(MFC_OpenMP)
5449# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5450
5451# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5452#endif
5453# 959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5454 do i = 1, num_fluids
5455 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5456# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5457 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5458# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5459 & eqn_idx%E + i)), 1._wp)
5460 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
5461# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5462 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
5463# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5464 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
5465# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5466 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5467# 967 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5468 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5469# 968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5470 end do
5471
5472
5473# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5474#if defined(MFC_OpenACC)
5475# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5476!$acc loop seq
5477# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5478#elif defined(MFC_OpenMP)
5479# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5480
5481# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5482#endif
5483# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5484 do i = 1, num_fluids
5485 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5486# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5487 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5488 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
5489# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5490 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5491 end do
5492 end if
5493
5494 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
5495 ! downstream
5496
5497# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5498#if defined(MFC_OpenACC)
5499# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5500!$acc loop seq
5501# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5502#elif defined(MFC_OpenMP)
5503# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5504
5505# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5506#endif
5507# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5508 do i = 1, num_fluids
5509 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5510# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5511 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
5512# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5513 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5514# 986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5515 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5516# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5517 end do
5518
5519 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
5520 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
5521
5522 if (viscous) then
5523 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
5524 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
5525 end if
5526
5527 if (chemistry) then
5528 c_sum_yi_phi = 0.0_wp
5529
5530# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5531#if defined(MFC_OpenACC)
5532# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5533!$acc loop seq
5534# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5535#elif defined(MFC_OpenMP)
5536# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5537
5538# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5539#endif
5540# 1000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5541 do i = eqn_idx%species%beg, eqn_idx%species%end
5542 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5543# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5544 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
5545# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5546 end do
5547
5548 call get_mixture_molecular_weight(ys_l, mw_l)
5549 call get_mixture_molecular_weight(ys_r, mw_r)
5550
5551 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
5552 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
5553
5554 r_gas_l = gas_constant/mw_l
5555 r_gas_r = gas_constant/mw_r
5556
5557 t_l = pres_l/rho_l/r_gas_l
5558 t_r = pres_r/rho_r/r_gas_r
5559
5560 call get_mixture_caloric_state(t_l, ys_l, cp_il, cp_l, cv_l, e_l)
5561 call get_mixture_caloric_state(t_r, ys_r, cp_ir, cp_r, cv_r, e_r)
5562
5563 if (chem_params%gamma_method == 1) then
5564 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5565 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
5566 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
5567
5568 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
5569 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
5570 else if (chem_params%gamma_method == 2) then
5571 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5572 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
5573 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5574 end if
5575
5576 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5577 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5578 h_l = (e_l + pres_l)/rho_l
5579 h_r = (e_r + pres_r)/rho_r
5580 else
5581 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
5582 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
5583
5584 h_l = (e_l + pres_l)/rho_l
5585 h_r = (e_r + pres_r)/rho_r
5586 end if
5587
5588# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5589 h_l = (e_l + pres_l)/rho_l
5590 h_r = (e_r + pres_r)/rho_r
5591# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5592
5593 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
5594 ! average costs eight square roots per face.
5595 if (wave_speeds == wave_speeds_pressure) then
5596 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
5597 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
5598 if (chemistry .and. avg_state == avg_state_roe) then
5599 r_species(1:num_species) = gas_constant/molecular_weights
5600 call get_species_enthalpies_rt(t_l, h_il)
5601 call get_species_enthalpies_rt(t_r, h_ir)
5602 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
5603 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
5604 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
5605 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
5606 & gamma_avg, c_sum_yi_phi)
5607 end if
5608 end if
5609
5610 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
5611
5612 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
5613
5614 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
5615 ! costs eight square roots per face under the Roe average.
5616 if (wave_speeds == wave_speeds_pressure) then
5617 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
5618 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
5619 & alpha_rho_r)
5620 end if
5621
5622 if (viscous) then
5623 if (chemistry) then
5624 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
5625 end if
5626
5627# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5628#if defined(MFC_OpenACC)
5629# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5630!$acc loop seq
5631# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5632#elif defined(MFC_OpenMP)
5633# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5634
5635# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5636#endif
5637# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5638 do i = 1, 2
5639 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5640# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5641 end do
5642 end if
5643
5644 ! Low Mach correction
5645 if (low_mach == 2) then
5646 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
5647 & vel_r(dir_idx(1)))
5648 end if
5649
5650 if (wave_speeds == wave_speeds_direct) then
5651# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5652 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5653 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5654 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5655 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
5656 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
5657# 1136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5658 else if (wave_speeds == wave_speeds_pressure) then
5659 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5660
5661 pres_sr = pres_sl
5662
5663 ! Low Mach correction: Thornber et al. JCP (2008)
5664 ms_l = max(1._wp, &
5665 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
5666 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
5667 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
5668 ms_r = max(1._wp, &
5669 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
5670 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
5671 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
5672
5673 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5674 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5675
5676 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5677 end if
5678
5679 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5680 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5681
5682 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5683 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5684 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5685 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
5686 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5687 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5688
5689 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5690 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5691 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5692
5693 ! Low Mach correction
5694 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
5695 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
5696
5697# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5698
5699 ! COMPUTING THE HLLC FLUXES MASS FLUX.
5700
5701# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5702#if defined(MFC_OpenACC)
5703# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5704!$acc loop seq
5705# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5706#elif defined(MFC_OpenMP)
5707# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5708
5709# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5710#endif
5711# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5712 do i = 1, eqn_idx%cont%end
5713 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5714# 1198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5715 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5716# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5717 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5718 end do
5719
5720# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5721
5722# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5723#if defined(MFC_OpenACC)
5724# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5725!$acc loop seq
5726# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5727#elif defined(MFC_OpenMP)
5728# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5729
5730# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5731#endif
5732# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5733 do i = 1, num_dims
5734 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
5735 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
5736 flux_rsx_vf(j, k, l, &
5737# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5738 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
5739 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
5740 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
5741 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5742 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
5743 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
5744 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
5745 end do
5746
5747 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
5748 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
5749 flux_rsx_vf(j, k, l, &
5750# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5751 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
5752 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
5753 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
5754 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
5755 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
5756# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5757
5758 ! VOLUME FRACTION FLUX.
5759
5760# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5761#if defined(MFC_OpenACC)
5762# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5763!$acc loop seq
5764# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5765#elif defined(MFC_OpenMP)
5766# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5767
5768# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5769#endif
5770# 1359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5771 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5772 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5773# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5774 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5775# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5776 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5777 end do
5778
5779 ! VOLUME FRACTION SOURCE FLUX.
5780
5781# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5782#if defined(MFC_OpenACC)
5783# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5784!$acc loop seq
5785# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5786#elif defined(MFC_OpenMP)
5787# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5788
5789# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5790#endif
5791# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5792 do i = 1, num_dims
5793 vel_src_rsx_vf(j, k, l, &
5794# 1369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5795 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
5796 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
5797 end do
5798
5799 ! COLOR FUNCTION FLUX
5800 if (surface_tension) then
5801 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
5802# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5803 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5804 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5805# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5806 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5807 end if
5808
5809 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5810# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5811
5812 if (chemistry) then
5813
5814# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5815#if defined(MFC_OpenACC)
5816# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5817!$acc loop seq
5818# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5819#elif defined(MFC_OpenMP)
5820# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5821
5822# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5823#endif
5824# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5825 do i = eqn_idx%species%beg, eqn_idx%species%end
5826 y_l = ql_prim_rsx_vf(j, k, l, i)
5827# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5828 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5829# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5830
5831 flux_rsx_vf(j, k, l, &
5832# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5833 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5834 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5835 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
5836# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5837 end do
5838 end if
5839
5840# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5841
5842 ! Geometrical source flux for cylindrical coordinates
5843# 1528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5844# 1552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5845 if (cyl_coord) then
5846 ! Substituting the advective flux into the inviscid geometrical source flux
5847
5848# 1554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5849#if defined(MFC_OpenACC)
5850# 1554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5851!$acc loop seq
5852# 1554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5853#elif defined(MFC_OpenMP)
5854# 1554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5855
5856# 1554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5857#endif
5858# 1555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5859 do i = 1, eqn_idx%E
5860 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5861# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5862 end do
5863 ! Recalculating the radial momentum geometric source flux
5864 flux_gsrc_rsx_vf(j, k, l, &
5865# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5866 & eqn_idx%cont%end + dir_idx(1)) &
5867 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, &
5868 & vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
5869 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
5870 ! Geometrical source of the void fraction(s) is zero
5871
5872# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5873#if defined(MFC_OpenACC)
5874# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5875!$acc loop seq
5876# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5877#elif defined(MFC_OpenMP)
5878# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5879
5880# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5881#endif
5882# 1566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5883 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5884 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5885# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5886 end do
5887 end if
5888# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5889# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5890# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5891 end do
5892 end do
5893 end do
5894
5895# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5896#if defined(MFC_OpenACC)
5897# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5898!$acc end parallel loop
5899# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5900#elif defined(MFC_OpenMP)
5901# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5902
5903# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5904!$omp end target teams loop
5905# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5906#endif
5907# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5908# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5909 end if
5910 end if
5911# 169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5912# 170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5913# 171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5914 if (norm_dir == 3) then
5915# 172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5916 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
5917 if (model_eqns == model_eqns_6eq) then
5918 ! 6-equation model (model_eqns=3): separate phasic internal energies
5919
5920# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5921
5922# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5923#if defined(MFC_OpenACC)
5924# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5925!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, &
5926# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5927!$acc& Cp_iL, Cp_iR, R_species, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, 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, &
5928# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5929!$acc& gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_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, &
5930# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5931!$acc& alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, alpha_K_star, alpha_rho_K_star, &
5932# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5933!$acc& p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
5934# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5935#elif defined(MFC_OpenMP)
5936# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5937
5938# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5939
5940# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5941
5942# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5943!$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, &
5944# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5945!$omp& vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, &
5946# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5947!$omp& H_R, 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, rho_avg, H_avg, &
5948# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5949!$omp& 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, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, &
5950# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5951!$omp& s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, alpha_K_star, alpha_rho_K_star, p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
5952# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5953#endif
5954# 185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5955 do l = is1%beg, is1%end
5956# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5957 do k = is2%beg, is2%end
5958# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5959 do j = is3%beg, is3%end
5960# 188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5961 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5962 rho_l = 0._wp; rho_r = 0._wp
5963 gamma_l = 0._wp; gamma_r = 0._wp
5964 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5965 qv_l = 0._wp; qv_r = 0._wp
5966 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
5967
5968
5969# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5970#if defined(MFC_OpenACC)
5971# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5972!$acc loop seq
5973# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5974#elif defined(MFC_OpenMP)
5975# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5976
5977# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5978#endif
5979# 196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5980 do i = 1, num_dims
5981 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5982# 198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5983 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
5984# 199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5985 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5986 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5987 end do
5988
5989 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5990# 204 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5991 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
5992# 205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5993
5994 rho_l = 0._wp
5995 gamma_l = 0._wp
5996 pi_inf_l = 0._wp
5997 qv_l = 0._wp
5998
5999 rho_r = 0._wp
6000 gamma_r = 0._wp
6001 pi_inf_r = 0._wp
6002 qv_r = 0._wp
6003
6004 alpha_l_sum = 0._wp
6005 alpha_r_sum = 0._wp
6006
6007 if (mpp_lim) then
6008
6009# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6010#if defined(MFC_OpenACC)
6011# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6012!$acc loop seq
6013# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6014#elif defined(MFC_OpenMP)
6015# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6016
6017# 220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6018#endif
6019# 221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6020 do i = 1, num_fluids
6021 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6022# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6023 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6024# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6025 & eqn_idx%E + i)), 1._wp)
6026 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6027# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6028 end do
6029
6030
6031# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6032#if defined(MFC_OpenACC)
6033# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6034!$acc loop seq
6035# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6036#elif defined(MFC_OpenMP)
6037# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6038
6039# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6040#endif
6041# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6042 do i = 1, num_fluids
6043 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
6044# 231 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6045 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
6046# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6047 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
6048# 233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6049 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6050# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6051 end do
6052
6053
6054# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6055#if defined(MFC_OpenACC)
6056# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6057!$acc loop seq
6058# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6059#elif defined(MFC_OpenMP)
6060# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6061
6062# 236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6063#endif
6064# 237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6065 do i = 1, num_fluids
6066 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6067# 239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6068 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6069 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
6070# 241 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6071 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6072 end do
6073 end if
6074
6075
6076# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6077#if defined(MFC_OpenACC)
6078# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6079!$acc loop seq
6080# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6081#elif defined(MFC_OpenMP)
6082# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6083
6084# 245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6085#endif
6086# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6087 do i = 1, num_fluids
6088 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
6089# 248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6090 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
6091# 249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6092 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6093# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6094 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
6095# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6096 end do
6097
6098 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
6099 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
6100
6101 if (viscous) then
6102 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
6103 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
6104 end if
6105
6106 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
6107 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
6108
6109 h_l = (e_l + pres_l)/rho_l
6110 h_r = (e_r + pres_r)/rho_r
6111
6112 ! Only the Roe path writes this, and chemistry is unreachable at model_eqns = 6eq; zero it
6113 ! so the sound speed below never reads an undefined value.
6114 c_sum_yi_phi = 0._wp
6115
6116 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
6117 ! average costs eight square roots per face.
6118 if (wave_speeds == wave_speeds_pressure) then
6119 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, &
6120 & qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
6121 end if
6122
6123 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
6124
6125 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
6126
6127 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
6128 ! costs eight square roots per face under the Roe average.
6129 if (wave_speeds == wave_speeds_pressure) then
6130 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
6131 & h_avg, c_sum_yi_phi, alpha_r, c_avg, alpha_rho_r)
6132 end if
6133
6134 if (viscous) then
6135
6136# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6137#if defined(MFC_OpenACC)
6138# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6139!$acc loop seq
6140# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6141#elif defined(MFC_OpenMP)
6142# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6143
6144# 290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6145#endif
6146# 291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6147 do i = 1, 2
6148 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6149# 293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6150 end do
6151 end if
6152
6153 ! Low Mach correction
6154 if (low_mach == 2) then
6155 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
6156 & vel_r(dir_idx(1)))
6157 end if
6158
6159 ! COMPUTING THE DIRECT WAVE SPEEDS
6160 if (wave_speeds == wave_speeds_direct) then
6161 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6162 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6163 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6164 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
6165 & - rho_r*(s_r - vel_r(dir_idx(1))))
6166 else if (wave_speeds == wave_speeds_pressure) then
6167 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6168
6169 pres_sr = pres_sl
6170
6171 ! Low Mach correction: Thornber et al. JCP (2008)
6172 ms_l = max(1._wp, &
6173 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
6174 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
6175 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
6176 ms_r = max(1._wp, &
6177 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
6178 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
6179 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
6180
6181 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6182 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6183
6184 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6185 end if
6186
6187 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6188 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6189
6190 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6191 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6192 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6193 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6194 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6195
6196 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6197 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
6198 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
6199
6200 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
6201 xi_mp = -min(0._wp, sign(1._wp, s_l))
6202 xi_pp = max(0._wp, sign(1._wp, s_r))
6203
6204 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l &
6205 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
6206 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
6207 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
6208 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
6209
6210 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
6211
6212 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + xi_mp*xi_pp*(s_s &
6213 & - vel_r(dir_idx(1)))
6214
6215 ! Low Mach correction
6216 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
6217 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
6218
6219 ! COMPUTING FLUXES MASS FLUX.
6220
6221# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6222#if defined(MFC_OpenACC)
6223# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6224!$acc loop seq
6225# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6226#elif defined(MFC_OpenMP)
6227# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6228
6229# 363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6230#endif
6231# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6232 do i = 1, eqn_idx%cont%end
6233 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6234# 366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6235 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6236# 367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6237 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6238 end do
6239
6240 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6241
6242# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6243#if defined(MFC_OpenACC)
6244# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6245!$acc loop seq
6246# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6247#elif defined(MFC_OpenMP)
6248# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6249
6250# 371 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6251#endif
6252# 372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6253 do i = 1, num_dims
6254 flux_rsx_vf(j, k, l, &
6255# 374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6256 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
6257 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
6258 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
6259 & *dir_flg(dir_idx(i))*pcorr
6260 end do
6261
6262 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
6263 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
6264# 382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6265
6266 ! VOLUME FRACTION FLUX.
6267
6268# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6269#if defined(MFC_OpenACC)
6270# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6271!$acc loop seq
6272# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6273#elif defined(MFC_OpenMP)
6274# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6275
6276# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6277#endif
6278# 385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6279 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6280 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6281# 387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6282 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
6283# 388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6284 end do
6285
6286 ! Advection velocity source: interface velocity for volume fraction transport
6287
6288# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6289#if defined(MFC_OpenACC)
6290# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6291!$acc loop seq
6292# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6293#elif defined(MFC_OpenMP)
6294# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6295
6296# 391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6297#endif
6298# 392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6299 do i = 1, num_dims
6300 vel_src_rsx_vf(j, k, l, &
6301# 394 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6302 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
6303 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
6304 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
6305 end do
6306
6307 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
6308 ! energy flux
6309
6310# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6311#if defined(MFC_OpenACC)
6312# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6313!$acc loop seq
6314# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6315#elif defined(MFC_OpenMP)
6316# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6317
6318# 401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6319#endif
6320# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6321 do i = 1, num_fluids
6322 ! Phasic isentrope p* from the upwind state: closed form for stiffened gas, integrated
6323 ! for a state-dependent EOS.
6324 call s_phase_pressure_on_isentrope(pres_l, alpha_rho_l(i)/max(alpha_l(i), sgm_eps), xi_l, i, &
6325 & p_isen_l)
6326 call s_phase_pressure_on_isentrope(pres_r, alpha_rho_r(i)/max(alpha_r(i), sgm_eps), xi_r, i, &
6327 & p_isen_r)
6328 p_k_star = xi_m*(xi_mp*(p_isen_l - pres_l) + pres_l) + xi_p*(xi_pp*(p_isen_r - pres_r) + pres_r)
6329
6330 alpha_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
6331# 412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6332 & i + eqn_idx%adv%beg - 1) &
6333 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6334# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6335 & i + eqn_idx%adv%beg - 1)
6336 alpha_rho_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
6337# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6338 & i + eqn_idx%cont%beg - 1) &
6339 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6340# 418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6341 & i + eqn_idx%cont%beg - 1)
6342 ! Star partial density xi_K alpha_rho, blended like p_K_Star: a state-dependent EOS reads
6343 ! its coefficients at the star density, not the upwind one.
6344 call s_phase_internal_energy(p_k_star, alpha_k_star, &
6345 & alpha_rho_k_star*(1._wp + xi_m*xi_mp*(xi_l - 1._wp) &
6346 & + xi_p*xi_pp*(xi_r - 1._wp)), i, e_k_star)
6347 flux_rsx_vf(j, k, l, &
6348# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6349 & i + eqn_idx%int_en%beg - 1) = e_k_star*vel_k_star + (s_m/s_l)*(s_p/s_r) &
6350 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
6351# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6352 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6353# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6354 & i + eqn_idx%adv%beg - 1))
6355 end do
6356
6357 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6358# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6359
6360 ! COLOR FUNCTION FLUX
6361 if (surface_tension) then
6362 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
6363# 436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6364 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
6365# 437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6366 end if
6367
6368 ! Geometrical source flux for cylindrical coordinates
6369# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6370# 463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6371 if (grid_geometry == 3) then
6372
6373# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6374#if defined(MFC_OpenACC)
6375# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6376!$acc loop seq
6377# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6378#elif defined(MFC_OpenMP)
6379# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6380
6381# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6382#endif
6383# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6384 do i = 1, sys_size
6385 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6386# 467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6387 end do
6388 flux_gsrc_rsx_vf(j, k, l, &
6389# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6390 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
6391# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6392 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
6393
6394 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
6395# 473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6396 end if
6397# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6398 end do
6399 end do
6400 end do
6401
6402# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6403#if defined(MFC_OpenACC)
6404# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6405!$acc end parallel loop
6406# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6407#elif defined(MFC_OpenMP)
6408# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6409
6410# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6411!$omp end target teams loop
6412# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6413#endif
6414# 479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6415 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
6416 ! 5-equation model with Euler-Euler bubble dynamics
6417
6418# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6419
6420# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6421#if defined(MFC_OpenACC)
6422# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6423!$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, alpha_rho_L, alpha_rho_R, h_avg, &
6424# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6425!$acc& gamma_avg, Re_L, Re_R, pcorr, 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, &
6426# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6427!$acc& Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, &
6428# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6429!$acc& R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR) firstprivate(Re_size_loc1, Re_size_loc2)
6430# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6431#elif defined(MFC_OpenMP)
6432# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6433
6434# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6435
6436# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6437
6438# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6439!$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, &
6440# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6441!$omp& R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, &
6442# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6443!$omp& 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, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, &
6444# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6445!$omp& s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR) &
6446# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6447!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
6448# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6449#endif
6450# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6451 do l = is1%beg, is1%end
6452# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6453 do k = is2%beg, is2%end
6454# 491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6455 do j = is3%beg, is3%end
6456# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6457 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6458 rho_l = 0._wp; rho_r = 0._wp
6459 gamma_l = 0._wp; gamma_r = 0._wp
6460 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6461 qv_l = 0._wp; qv_r = 0._wp
6462
6463
6464# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6465#if defined(MFC_OpenACC)
6466# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6467!$acc loop seq
6468# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6469#elif defined(MFC_OpenMP)
6470# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6471
6472# 498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6473#endif
6474# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6475 do i = 1, num_fluids
6476 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
6477# 501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6478 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
6479# 502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6480 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6481# 503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6482 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6483# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6484 end do
6485
6486 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6487
6488
6489# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6490#if defined(MFC_OpenACC)
6491# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6492!$acc loop seq
6493# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6494#elif defined(MFC_OpenMP)
6495# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6496
6497# 508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6498#endif
6499# 509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6500 do i = 1, num_dims
6501 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6502# 511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6503 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
6504# 512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6505 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6506 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6507 end do
6508
6509 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
6510 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
6511
6512 if (viscous) then
6513 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
6514
6515# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6516#if defined(MFC_OpenACC)
6517# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6518!$acc loop seq
6519# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6520#elif defined(MFC_OpenMP)
6521# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6522
6523# 521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6524#endif
6525# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6526 do i = 1, 2
6527 re_l(i) = dflt_real
6528 re_r(i) = dflt_real
6529
6530 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
6531 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
6532
6533
6534# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6535#if defined(MFC_OpenACC)
6536# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6537!$acc loop seq
6538# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6539#elif defined(MFC_OpenMP)
6540# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6541
6542# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6543#endif
6544# 530 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6545 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
6546 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
6547# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6548 & q)))/res_gs(i, q) + re_l(i)
6549 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
6550# 534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6551 & q)))/res_gs(i, q) + re_r(i)
6552 end do
6553
6554 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6555 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6556 end do
6557 end if
6558 end if
6559
6560 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6561# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6562 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
6563# 545 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6564
6565 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
6566 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
6567
6568 h_l = (e_l + pres_l)/rho_l
6569 h_r = (e_r + pres_r)/rho_r
6570
6571 if (avg_state == avg_state_arithmetic) then
6572
6573# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6574#if defined(MFC_OpenACC)
6575# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6576!$acc loop seq
6577# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6578#elif defined(MFC_OpenMP)
6579# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6580
6581# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6582#endif
6583# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6584 do i = 1, nb
6585 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
6586# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6587 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
6588# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6589
6590 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
6591# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6592 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
6593# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6594 if (.not. polytropic .and. .not. qbmm) then
6595 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
6596# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6597 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
6598# 563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6599 end if
6600 end do
6601
6602 if (.not. qbmm) then
6603 if (adv_n) then
6604 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
6605# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6606 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
6607# 570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6608 else
6609 nbub_l = 0._wp
6610 nbub_r = 0._wp
6611
6612# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6613#if defined(MFC_OpenACC)
6614# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6615!$acc loop seq
6616# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6617#elif defined(MFC_OpenMP)
6618# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6619
6620# 573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6621#endif
6622# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6623 do i = 1, nb
6624 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
6625 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
6626 end do
6627
6628 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
6629# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6630 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
6631# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6632 & eqn_idx%E + num_fluids)/nbub_r
6633 end if
6634 else
6635 ! nb stored in 0th moment of first R0 bin in variable conversion module
6636 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
6637# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6638 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
6639# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6640 end if
6641
6642
6643# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6644#if defined(MFC_OpenACC)
6645# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6646!$acc loop seq
6647# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6648#elif defined(MFC_OpenMP)
6649# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6650
6651# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6652#endif
6653# 590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6654 do i = 1, nb
6655 if (.not. qbmm) then
6656 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
6657 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
6658 end if
6659 end do
6660
6661 if (qbmm) then
6662 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
6663# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6664 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
6665# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6666
6667 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
6668# 602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6669 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
6670# 603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6671
6672 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
6673# 605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6674 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
6675# 606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6676 else
6677 pbwr3lbar = 0._wp
6678 pbwr3rbar = 0._wp
6679
6680 r3lbar = 0._wp
6681 r3rbar = 0._wp
6682
6683 r3v2lbar = 0._wp
6684 r3v2rbar = 0._wp
6685
6686
6687# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6688#if defined(MFC_OpenACC)
6689# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6690!$acc loop seq
6691# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6692#elif defined(MFC_OpenMP)
6693# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6694
6695# 616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6696#endif
6697# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6698 do i = 1, nb
6699 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
6700 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
6701
6702 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
6703 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
6704
6705 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
6706 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
6707 end do
6708 end if
6709
6710 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6711 h_avg = 5.e-1_wp*(h_l + h_r)
6712 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6713 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6714 vel_avg_rms = 0._wp
6715
6716
6717# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6718#if defined(MFC_OpenACC)
6719# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6720!$acc loop seq
6721# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6722#elif defined(MFC_OpenMP)
6723# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6724
6725# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6726#endif
6727# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6728 do i = 1, num_dims
6729 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6730 end do
6731 end if
6732
6733 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
6734
6735 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
6736
6737 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
6738 ! costs eight square roots per face under the Roe average.
6739 if (wave_speeds == wave_speeds_pressure) then
6740 ! Zero, not c_sum_Yi_Phi: this loop never forms the chemistry average, and
6741 ! chemistry with bubbles_euler/qbmm is prohibited, so the branch is unreachable.
6742 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
6743 & h_avg, 0._wp, alpha_r, c_avg, alpha_rho_r)
6744 end if
6745
6746 if (viscous) then
6747
6748# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6749#if defined(MFC_OpenACC)
6750# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6751!$acc loop seq
6752# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6753#elif defined(MFC_OpenMP)
6754# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6755
6756# 655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6757#endif
6758# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6759 do i = 1, 2
6760 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6761# 658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6762 end do
6763 end if
6764
6765 ! Low Mach correction
6766 if (low_mach == 2) then
6767 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
6768 & vel_r(dir_idx(1)))
6769 end if
6770
6771 if (wave_speeds == wave_speeds_direct) then
6772 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6773 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6774
6775 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6776 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
6777 & - rho_r*(s_r - vel_r(dir_idx(1))))
6778 else if (wave_speeds == wave_speeds_pressure) then
6779 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6780
6781 pres_sr = pres_sl
6782
6783 ! Low Mach correction: Thornber et al. JCP (2008)
6784 ms_l = max(1._wp, &
6785 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
6786 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
6787 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
6788 ms_r = max(1._wp, &
6789 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
6790 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
6791 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
6792
6793 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6794 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6795
6796 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6797 end if
6798
6799 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6800 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6801
6802 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6803 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6804 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6805 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6806 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6807
6808 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6809 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
6810 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
6811
6812 ! Low Mach correction
6813 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
6814 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
6815
6816
6817# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6818#if defined(MFC_OpenACC)
6819# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6820!$acc loop seq
6821# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6822#elif defined(MFC_OpenMP)
6823# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6824
6825# 712 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6826#endif
6827# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6828 do i = 1, eqn_idx%cont%end
6829 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6830# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6831 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6832# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6833 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6834 end do
6835
6836 if (bubbles_euler .and. (num_fluids > 1)) then
6837 ! Kill mass transport @ gas density
6838 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
6839# 722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6840 end if
6841
6842 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6843
6844 ! Include p_tilde
6845
6846 if (avg_state == avg_state_arithmetic) then
6847 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
6848 pres_l = pres_l - alpha_l(num_fluids)*pres_l
6849 else
6850 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
6851 end if
6852
6853 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
6854 pres_r = pres_r - alpha_r(num_fluids)*pres_r
6855 else
6856 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
6857 end if
6858 end if
6859
6860
6861# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6862#if defined(MFC_OpenACC)
6863# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6864!$acc loop seq
6865# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6866#elif defined(MFC_OpenMP)
6867# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6868
6869# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6870#endif
6871# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6872 do i = 1, num_dims
6873 flux_rsx_vf(j, k, l, &
6874# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6875 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
6876 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
6877 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
6878 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
6879 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
6880 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
6881 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
6882 end do
6883
6884 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
6885 flux_rsx_vf(j, k, l, &
6886# 756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6887 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
6888 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
6889 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
6890 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
6891 & *pcorr*s_s
6892
6893 ! Volume fraction flux
6894
6895# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6896#if defined(MFC_OpenACC)
6897# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6898!$acc loop seq
6899# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6900#elif defined(MFC_OpenMP)
6901# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6902
6903# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6904#endif
6905# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6906 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6907 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6908# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6909 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6910# 767 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6911 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6912 end do
6913
6914 ! Advection velocity source: interface velocity for volume fraction transport
6915
6916# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6917#if defined(MFC_OpenACC)
6918# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6919!$acc loop seq
6920# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6921#elif defined(MFC_OpenMP)
6922# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6923
6924# 771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6925#endif
6926# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6927 do i = 1, num_dims
6928 vel_src_rsx_vf(j, k, l, &
6929# 774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6930 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
6931 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
6932 end do
6933
6934 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6935# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6936
6937 ! Add advection flux for bubble variables
6938
6939# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6940#if defined(MFC_OpenACC)
6941# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6942!$acc loop seq
6943# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6944#elif defined(MFC_OpenMP)
6945# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6946
6947# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6948#endif
6949# 782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6950 do i = eqn_idx%bub%beg, eqn_idx%bub%end
6951 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
6952# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6953 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6954 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6955# 786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6956 end do
6957
6958 if (qbmm) then
6959 flux_rsx_vf(j, k, l, &
6960# 790 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6961 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6962 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6963 end if
6964
6965 if (adv_n) then
6966 flux_rsx_vf(j, k, l, &
6967# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6968 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6969 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6970 end if
6971
6972 ! Geometrical source flux for cylindrical coordinates
6973# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6974# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6975 if (grid_geometry == 3) then
6976
6977# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6978#if defined(MFC_OpenACC)
6979# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6980!$acc loop seq
6981# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6982#elif defined(MFC_OpenMP)
6983# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6984
6985# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6986#endif
6987# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6988 do i = 1, sys_size
6989 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6990# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6991 end do
6992
6993 flux_gsrc_rsx_vf(j, k, l, &
6994# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6995 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
6996 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
6997 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
6998 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
6999# 833 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7000 end if
7001# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7002 end do
7003 end do
7004 end do
7005
7006# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7007#if defined(MFC_OpenACC)
7008# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7009!$acc end parallel loop
7010# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7011#elif defined(MFC_OpenMP)
7012# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7013
7014# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7015!$omp end target teams loop
7016# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7017#endif
7018# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7019# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7020# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7021 else if (hypoelasticity) then
7022# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7023 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
7024 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
7025 ! statement and private variable from the pure-fluid emission, keeping its body and directive
7026 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
7027 ! pinned it at the GPU register ceiling for every HLLC user.
7028 ! One source of truth for this kernel's private variables: both emissions of the shared body take
7029 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
7030 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
7031 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
7032# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7033# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7034# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7035# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7036# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7037# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7038# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7039# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7040# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7041# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7042# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7043# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7044# 879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7045# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7046# 886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7047 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
7048 ! both emissions the same name; amdflang then launches the wrong one and a
7049 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
7050 ! give two line numbers. Do not merge them back into one (still faults on AFAR 24.3).
7051# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7052
7053# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7054
7055# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7056#if defined(MFC_OpenACC)
7057# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7058!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, 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, &
7059# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7060!$acc& 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, c_sum_Yi_Phi, 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, &
7061# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7062!$acc& s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, &
7063# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7064!$acc& vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR, ptilde_L, ptilde_R, tau_e_L, tau_e_R, G_L, G_R, damage_L, damage_R, solid_partial_density_L, &
7065# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7066!$acc& solid_partial_density_R, U_L, U_R, F_L, F_R, F_star_L, F_star_R, F_HLLC, u_n_HLLC, u_t_HLLC, u_t2_HLLC, pres_tot_L, pres_tot_R, u_n_L, u_n_R, u_t_L, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nn_R, &
7067# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7068!$acc& tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, p_face, tau_qq_face, A_L, A_R, denom_A, u_t_star, tau_nt_star, &
7069# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7070!$acc& u_t2_star, tau_nt2_star, pres_tot_star, F_HLL, u_n_HLL_trace, u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, &
7071# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7072!$acc& a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
7073# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7074#elif defined(MFC_OpenMP)
7075# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7076
7077# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7078
7079# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7080
7081# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7082!$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, &
7083# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7084!$omp& 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, &
7085# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7086!$omp& Cv_L, Cv_R, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, &
7087# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7088!$omp& pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
7089# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7090!$omp& Cp_iR, R_species, h_iL, h_iR, ptilde_L, ptilde_R, tau_e_L, tau_e_R, G_L, G_R, damage_L, damage_R, solid_partial_density_L, solid_partial_density_R, U_L, U_R, F_L, F_R, F_star_L, F_star_R, &
7091# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7092!$omp& F_HLLC, u_n_HLLC, u_t_HLLC, u_t2_HLLC, pres_tot_L, pres_tot_R, u_n_L, u_n_R, u_t_L, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nn_R, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, tau_nt2_L, tau_nt2_R, &
7093# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7094!$omp& tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, p_face, tau_qq_face, A_L, A_R, denom_A, u_t_star, tau_nt_star, u_t2_star, tau_nt2_star, pres_tot_star, F_HLL, u_n_HLL_trace, &
7095# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7096!$omp& u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, &
7097# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7098!$omp& sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
7099# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7100#endif
7101# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7102# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7103 do l = is1%beg, is1%end
7104# 898 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7105 do k = is2%beg, is2%end
7106# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7107 do j = is3%beg, is3%end
7108# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7109 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7110 rho_l = 0._wp; rho_r = 0._wp
7111 gamma_l = 0._wp; gamma_r = 0._wp
7112 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7113 qv_l = 0._wp; qv_r = 0._wp
7114 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
7115
7116
7117# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7118#if defined(MFC_OpenACC)
7119# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7120!$acc loop seq
7121# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7122#elif defined(MFC_OpenMP)
7123# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7124
7125# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7126#endif
7127# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7128 do i = 1, num_fluids
7129 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7130# 910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7131 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7132# 911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7133 end do
7134
7135
7136# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7137#if defined(MFC_OpenACC)
7138# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7139!$acc loop seq
7140# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7141#elif defined(MFC_OpenMP)
7142# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7143
7144# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7145#endif
7146# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7147 do i = 1, num_dims
7148 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7149# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7150 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7151# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7152 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7153 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7154 end do
7155
7156 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7157# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7158 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7159# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7160
7161# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7162
7163# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7164#if defined(MFC_OpenACC)
7165# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7166!$acc loop seq
7167# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7168#elif defined(MFC_OpenMP)
7169# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7170
7171# 925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7172#endif
7173# 926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7174 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7175 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
7176# 928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7177 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
7178# 929 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7179 end do
7180
7181 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
7182 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
7183 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
7184 if (n > 0) then
7185 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
7186 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
7187 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
7188 end if
7189 if (p > 0) then
7190 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
7191 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
7192 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
7193 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
7194 end if
7195 pres_tot_l = pres_l - tau_nn_l
7196 pres_tot_r = pres_r - tau_nn_r
7197 if (cyl_coord) then
7198 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
7199 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
7200 else
7201 tau_qq_l = 0._wp
7202 tau_qq_r = 0._wp
7203 end if
7204# 955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7205
7206 ! Change this by splitting it into the cases present in the bubbles_euler
7207 if (mpp_lim) then
7208
7209# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7210#if defined(MFC_OpenACC)
7211# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7212!$acc loop seq
7213# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7214#elif defined(MFC_OpenMP)
7215# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7216
7217# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7218#endif
7219# 959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7220 do i = 1, num_fluids
7221 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
7222# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7223 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
7224# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7225 & eqn_idx%E + i)), 1._wp)
7226 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
7227# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7228 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
7229# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7230 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
7231# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7232 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7233# 967 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7234 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7235# 968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7236 end do
7237
7238
7239# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7240#if defined(MFC_OpenACC)
7241# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7242!$acc loop seq
7243# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7244#elif defined(MFC_OpenMP)
7245# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7246
7247# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7248#endif
7249# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7250 do i = 1, num_fluids
7251 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
7252# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7253 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
7254 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
7255# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7256 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
7257 end do
7258 end if
7259
7260 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
7261 ! downstream
7262
7263# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7264#if defined(MFC_OpenACC)
7265# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7266!$acc loop seq
7267# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7268#elif defined(MFC_OpenMP)
7269# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7270
7271# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7272#endif
7273# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7274 do i = 1, num_fluids
7275 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7276# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7277 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7278# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7279 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7280# 986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7281 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7282# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7283 end do
7284
7285 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
7286 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
7287
7288 if (viscous) then
7289 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
7290 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
7291 end if
7292
7293 if (chemistry) then
7294 c_sum_yi_phi = 0.0_wp
7295
7296# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7297#if defined(MFC_OpenACC)
7298# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7299!$acc loop seq
7300# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7301#elif defined(MFC_OpenMP)
7302# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7303
7304# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7305#endif
7306# 1000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7307 do i = eqn_idx%species%beg, eqn_idx%species%end
7308 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
7309# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7310 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
7311# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7312 end do
7313
7314 call get_mixture_molecular_weight(ys_l, mw_l)
7315 call get_mixture_molecular_weight(ys_r, mw_r)
7316
7317 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
7318 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
7319
7320 r_gas_l = gas_constant/mw_l
7321 r_gas_r = gas_constant/mw_r
7322
7323 t_l = pres_l/rho_l/r_gas_l
7324 t_r = pres_r/rho_r/r_gas_r
7325
7326 call get_mixture_caloric_state(t_l, ys_l, cp_il, cp_l, cv_l, e_l)
7327 call get_mixture_caloric_state(t_r, ys_r, cp_ir, cp_r, cv_r, e_r)
7328
7329 if (chem_params%gamma_method == 1) then
7330 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
7331 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
7332 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
7333
7334 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
7335 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
7336 else if (chem_params%gamma_method == 2) then
7337 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
7338 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
7339 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
7340 end if
7341
7342 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
7343 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
7344 h_l = (e_l + pres_l)/rho_l
7345 h_r = (e_r + pres_r)/rho_r
7346 else
7347 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
7348 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
7349
7350 h_l = (e_l + pres_l)/rho_l
7351 h_r = (e_r + pres_r)/rho_r
7352 end if
7353
7354# 1046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7355 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
7356
7357# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7358#if defined(MFC_OpenACC)
7359# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7360!$acc loop seq
7361# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7362#elif defined(MFC_OpenMP)
7363# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7364
7365# 1047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7366#endif
7367# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7368 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7369 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
7370# 1050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7371 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
7372# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7373 end do
7374 damage_l = 0._wp; damage_r = 0._wp
7375 if (cont_damage) then
7376 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
7377# 1055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7378 damage_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%damage)
7379# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7380 end if
7381
7382 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
7383 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
7384 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
7385 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
7386 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
7387 ! keep their pre-adjustment values here.
7388# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7389
7390 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
7391 ! average costs eight square roots per face.
7392 if (wave_speeds == wave_speeds_pressure) then
7393 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
7394 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
7395 if (chemistry .and. avg_state == avg_state_roe) then
7396 r_species(1:num_species) = gas_constant/molecular_weights
7397 call get_species_enthalpies_rt(t_l, h_il)
7398 call get_species_enthalpies_rt(t_r, h_ir)
7399 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
7400 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
7401 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
7402 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
7403 & gamma_avg, c_sum_yi_phi)
7404 end if
7405 end if
7406
7407 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
7408
7409 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
7410
7411 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
7412 ! costs eight square roots per face under the Roe average.
7413 if (wave_speeds == wave_speeds_pressure) then
7414 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
7415 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
7416 & alpha_rho_r)
7417 end if
7418
7419 if (viscous) then
7420 if (chemistry) then
7421 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
7422 end if
7423
7424# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7425#if defined(MFC_OpenACC)
7426# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7427!$acc loop seq
7428# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7429#elif defined(MFC_OpenMP)
7430# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7431
7432# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7433#endif
7434# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7435 do i = 1, 2
7436 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7437# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7438 end do
7439 end if
7440
7441 ! Low Mach correction
7442 if (low_mach == 2) then
7443 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
7444 & vel_r(dir_idx(1)))
7445 end if
7446
7447 if (wave_speeds == wave_speeds_direct) then
7448# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7449 ! Elastic wave speed, Rodriguez et al. JCP (2019)
7450 s_l = min(vel_l(dir_idx(1)) - f_elastic_signal_speed(c_l, g_l, &
7451 & tau_e_l(dir_idx_tau(1)), rho_l), &
7452 & vel_r(dir_idx(1)) - f_elastic_signal_speed(c_r, g_r, &
7453 & tau_e_r(dir_idx_tau(1)), rho_r))
7454 s_r = max(vel_r(dir_idx(1)) + f_elastic_signal_speed(c_r, g_r, &
7455 & tau_e_r(dir_idx_tau(1)), rho_r), &
7456 & vel_l(dir_idx(1)) + f_elastic_signal_speed(c_l, g_l, &
7457 & tau_e_l(dir_idx_tau(1)), rho_l))
7458 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
7459 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
7460 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
7461 & - vel_r(dir_idx(1))))
7462# 1136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7463 else if (wave_speeds == wave_speeds_pressure) then
7464 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7465
7466 pres_sr = pres_sl
7467
7468 ! Low Mach correction: Thornber et al. JCP (2008)
7469 ms_l = max(1._wp, &
7470 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
7471 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
7472 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
7473 ms_r = max(1._wp, &
7474 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
7475 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
7476 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
7477
7478 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7479 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7480
7481 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7482 end if
7483
7484 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7485 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7486
7487 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7488 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7489 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7490 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
7491 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7492 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7493
7494 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7495 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7496 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7497
7498 ! Low Mach correction
7499 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
7500 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
7501
7502# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7503 if (n == 0) then
7504 u_t_l = 0._wp; u_t_r = 0._wp
7505 tau_nt_l = 0._wp; tau_nt_r = 0._wp
7506 end if
7507 if (p == 0) then
7508 u_t2_l = 0._wp; u_t2_r = 0._wp
7509 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
7510 end if
7511 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
7512 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
7513 denom_a = a_r - a_l
7514 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
7515 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
7516 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
7517 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
7518 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
7519# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7520
7521 ! COMPUTING THE HLLC FLUXES MASS FLUX.
7522
7523# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7524#if defined(MFC_OpenACC)
7525# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7526!$acc loop seq
7527# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7528#elif defined(MFC_OpenMP)
7529# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7530
7531# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7532#endif
7533# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7534 do i = 1, eqn_idx%cont%end
7535 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7536# 1198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7537 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7538# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7539 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7540 end do
7541
7542# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7543 flux_rsx_vf(j, k, l, &
7544# 1204 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7545 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
7546 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
7547 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
7548 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
7549 if (n > 0) then
7550 flux_rsx_vf(j, k, l, &
7551# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7552 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
7553 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
7554 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
7555 & - tau_nt_r)
7556 end if
7557 if (p > 0) then
7558 flux_rsx_vf(j, k, l, &
7559# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7560 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
7561 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
7562 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
7563 & - tau_nt2_r)
7564 end if
7565
7566 flux_rsx_vf(j, k, l, &
7567# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7568 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
7569 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
7570 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
7571 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
7572 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
7573 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
7574 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
7575 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
7576 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
7577 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7578
7579 if (n == 0) then
7580 flux_rsx_vf(j, k, l, &
7581# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7582 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
7583 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
7584 & + s_p*(xi_r - 1._wp))
7585 else if (p == 0) then
7586 if (dir_idx(1) == 1) then
7587 flux_rsx_vf(j, k, l, &
7588# 1243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7589 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
7590 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
7591 & + s_p*(xi_r - 1._wp))
7592 flux_rsx_vf(j, k, l, &
7593# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7594 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
7595 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
7596 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
7597 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
7598 flux_rsx_vf(j, k, l, &
7599# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7600 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
7601 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
7602 & + s_p*(xi_r - 1._wp))
7603 else
7604 flux_rsx_vf(j, k, l, &
7605# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7606 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
7607 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
7608 & + s_p*(xi_r - 1._wp))
7609 flux_rsx_vf(j, k, l, &
7610# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7611 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
7612 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
7613 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
7614 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
7615 flux_rsx_vf(j, k, l, &
7616# 1266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7617 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
7618 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
7619 & + s_p*(xi_r - 1._wp))
7620 end if
7621 else
7622 flux_rsx_vf(j, k, l, &
7623# 1272 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7624 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
7625 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7626 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7627 flux_rsx_vf(j, k, l, &
7628# 1276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7629 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
7630 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
7631 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
7632 & - rho_r*tau_nt_r))
7633 flux_rsx_vf(j, k, l, &
7634# 1281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7635 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
7636 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
7637 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
7638 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
7639 flux_rsx_vf(j, k, l, &
7640# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7641 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
7642 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7643 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7644 flux_rsx_vf(j, k, l, &
7645# 1290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7646 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
7647 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7648 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7649 flux_rsx_vf(j, k, l, &
7650# 1294 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7651 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
7652 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7653 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7654 end if
7655 if (cyl_coord) then
7656 flux_rsx_vf(j, k, l, &
7657# 1300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7658 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
7659 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
7660 & + s_p*(xi_r - 1._wp))
7661 end if
7662
7663 ! Damage flux: U_D = m_s*D (damageable-solid partial mass)
7664 if (cont_damage) then
7665 solid_partial_density_l = 0._wp; solid_partial_density_r = 0._wp
7666
7667# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7668#if defined(MFC_OpenACC)
7669# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7670!$acc loop seq
7671# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7672#elif defined(MFC_OpenMP)
7673# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7674
7675# 1308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7676#endif
7677# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7678 do i = 1, num_fluids
7679 if (gs_rs(i) > verysmall) then
7680 solid_partial_density_l = solid_partial_density_l + alpha_rho_l(i)
7681 solid_partial_density_r = solid_partial_density_r + alpha_rho_r(i)
7682 end if
7683 end do
7684 flux_rsx_vf(j, k, l, &
7685# 1316 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7686 & eqn_idx%damage) &
7687 & = xi_m*solid_partial_density_l*damage_l*(vel_l(dir_idx(1)) + s_m*(xi_l &
7688 & - 1._wp)) + xi_p*solid_partial_density_r*damage_r*(vel_r(dir_idx(1)) &
7689 & + s_p*(xi_r - 1._wp))
7690 end if
7691
7692 if (s_l >= 0._wp) then
7693 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
7694 else if (s_r <= 0._wp) then
7695 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
7696 else
7697 u_n_hllc = s_s*(xi_m*xi_l + xi_p*xi_r); u_t_hllc = u_t_star; u_t2_hllc = u_t2_star
7698 end if
7699 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
7700# 1330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7701 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
7702# 1331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7703 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
7704# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7705# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7706
7707 ! VOLUME FRACTION FLUX.
7708
7709# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7710#if defined(MFC_OpenACC)
7711# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7712!$acc loop seq
7713# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7714#elif defined(MFC_OpenMP)
7715# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7716
7717# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7718#endif
7719# 1359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7720 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7721 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7722# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7723 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7724# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7725 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7726 end do
7727
7728 ! VOLUME FRACTION SOURCE FLUX.
7729
7730# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7731#if defined(MFC_OpenACC)
7732# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7733!$acc loop seq
7734# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7735#elif defined(MFC_OpenMP)
7736# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7737
7738# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7739#endif
7740# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7741 do i = 1, num_dims
7742 vel_src_rsx_vf(j, k, l, &
7743# 1369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7744 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
7745 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
7746 end do
7747
7748 ! COLOR FUNCTION FLUX
7749 if (surface_tension) then
7750 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
7751# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7752 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7753 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7754# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7755 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7756 end if
7757
7758 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7759# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7760
7761 if (chemistry) then
7762
7763# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7764#if defined(MFC_OpenACC)
7765# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7766!$acc loop seq
7767# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7768#elif defined(MFC_OpenMP)
7769# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7770
7771# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7772#endif
7773# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7774 do i = eqn_idx%species%beg, eqn_idx%species%end
7775 y_l = ql_prim_rsx_vf(j, k, l, i)
7776# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7777 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
7778# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7779
7780 flux_rsx_vf(j, k, l, &
7781# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7782 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7783 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7784 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
7785# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7786 end do
7787 end if
7788
7789# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7790 ! HLLC-ADC blending for hypoelasticity
7791 if (riemann_hypo_adc) then
7792 ! Build U_L, U_R and F_L, F_R in local-basis layout
7793
7794# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7795#if defined(MFC_OpenACC)
7796# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7797!$acc loop seq
7798# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7799#elif defined(MFC_OpenMP)
7800# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7801
7802# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7803#endif
7804# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7805 do i = 1, num_fluids
7806 u_l(i) = alpha_rho_l(i)
7807 u_r(i) = alpha_rho_r(i)
7808 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
7809 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
7810 f_l(i) = alpha_rho_l(i)*u_n_l
7811 f_r(i) = alpha_rho_r(i)*u_n_r
7812 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
7813 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
7814 end do
7815
7816 ! Momentum U/F in physical order via dir_idx
7817 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
7818 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
7819 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
7820 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
7821 if (n > 0) then
7822 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
7823 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
7824 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
7825 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
7826 end if
7827 if (p > 0) then
7828 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
7829 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
7830 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
7831 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
7832 end if
7833
7834 u_l(eqn_idx%E) = e_l
7835 u_r(eqn_idx%E) = e_r
7836 f_l(eqn_idx%E) = (e_l + pres_tot_l)*u_n_l - u_t_l*tau_nt_l - u_t2_l*tau_nt2_l
7837 f_r(eqn_idx%E) = (e_r + pres_tot_r)*u_n_r - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r
7838
7839 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
7840
7841# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7842#if defined(MFC_OpenACC)
7843# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7844!$acc loop seq
7845# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7846#elif defined(MFC_OpenMP)
7847# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7848
7849# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7850#endif
7851# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7852 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
7853 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
7854 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
7855 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
7856 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
7857 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
7858 end do
7859 if (cyl_coord) then
7860 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
7861 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
7862 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
7863 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
7864 end if
7865
7866 ! Compute F_HLL (physical order) and HLL trace velocities
7867 if (s_l >= 0._wp) then
7868
7869# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7870#if defined(MFC_OpenACC)
7871# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7872!$acc loop seq
7873# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7874#elif defined(MFC_OpenMP)
7875# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7876
7877# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7878#endif
7879# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7880 do i = 1, sys_size
7881 f_hll(i) = f_l(i)
7882 end do
7883 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
7884 else if (s_r <= 0._wp) then
7885
7886# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7887#if defined(MFC_OpenACC)
7888# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7889!$acc loop seq
7890# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7891#elif defined(MFC_OpenMP)
7892# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7893
7894# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7895#endif
7896# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7897 do i = 1, sys_size
7898 f_hll(i) = f_r(i)
7899 end do
7900 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
7901 else
7902
7903# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7904#if defined(MFC_OpenACC)
7905# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7906!$acc loop seq
7907# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7908#elif defined(MFC_OpenMP)
7909# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7910
7911# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7912#endif
7913# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7914 do i = 1, sys_size
7915 f_hll(i) = (s_r*f_l(i) - s_l*f_r(i) + s_l*s_r*(u_r(i) - u_l(i)))/(s_r - s_l &
7916 & + verysmall)
7917 end do
7918 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
7919 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
7920 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
7921 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
7922 end if
7923
7924 ! ADC sensor
7925 sigma_l = pres_tot_l
7926 sigma_r = pres_tot_r
7927 dsigma = sigma_r - sigma_l
7928 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
7929
7930 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
7931 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
7932 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
7933
7934 du_t = u_t_r - u_t_l
7935 dtau_nt = tau_nt_r - tau_nt_l
7936 du_t2 = u_t2_r - u_t2_l
7937 dtau_nt2 = tau_nt2_r - tau_nt2_l
7938
7939 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
7940 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
7941 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
7942 & + verysmall)
7943
7944 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
7945 phi = exp(-(sensor_combined**adc_power))
7946
7947 ! Blend all flux components: F_HLL is in physical order
7948
7949# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7950#if defined(MFC_OpenACC)
7951# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7952!$acc loop seq
7953# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7954#elif defined(MFC_OpenMP)
7955# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7956
7957# 1500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7958#endif
7959# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7960 do i = 1, sys_size
7961 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
7962# 1503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7963 end do
7964
7965 ! Blend interface velocities (scalar HLL traces)
7966 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
7967 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
7968 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
7969
7970 ! Overwrite vel_src with blended velocities
7971 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
7972# 1512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7973 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
7974# 1513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7975 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
7976# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7977
7978 ! Update advection source flux with ADC-blended face-normal velocity
7979 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
7980# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7981
7982 ! Overwrite nc_iface_vel with blended velocities
7983 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
7984# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7985 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
7986# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7987 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
7988# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7989 end if
7990 ! END HLLC-ADC
7991# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7992
7993 ! Geometrical source flux for cylindrical coordinates
7994# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7995# 1573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7996 if (grid_geometry == 3) then
7997
7998# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7999#if defined(MFC_OpenACC)
8000# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8001!$acc loop seq
8002# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8003#elif defined(MFC_OpenMP)
8004# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8005
8006# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8007#endif
8008# 1575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8009 do i = 1, sys_size
8010 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
8011# 1577 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8012 end do
8013
8014 flux_gsrc_rsx_vf(j, k, l, &
8015# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8016 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
8017 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
8018 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
8019 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, &
8020# 1584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8021 & eqn_idx%mom%beg + 1)
8022 end if
8023# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8024 end do
8025 end do
8026 end do
8027
8028# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8029#if defined(MFC_OpenACC)
8030# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8031!$acc end parallel loop
8032# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8033#elif defined(MFC_OpenMP)
8034# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8035
8036# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8037!$omp end target teams loop
8038# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8039#endif
8040# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8041# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8042# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8043 else
8044# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8045 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
8046 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
8047 ! statement and private variable from the pure-fluid emission, keeping its body and directive
8048 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
8049 ! pinned it at the GPU register ceiling for every HLLC user.
8050 ! One source of truth for this kernel's private variables: both emissions of the shared body take
8051 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
8052 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
8053 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
8054# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8055# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8056# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8057# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8058# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8059# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8060# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8061# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8062# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8063# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8064# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8065# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8066# 883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8067# 885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8068# 886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8069 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
8070 ! both emissions the same name; amdflang then launches the wrong one and a
8071 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
8072 ! give two line numbers. Do not merge them back into one (still faults on AFAR 24.3).
8073# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8074
8075# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8076
8077# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8078#if defined(MFC_OpenACC)
8079# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8080!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, 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, &
8081# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8082!$acc& 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, c_sum_Yi_Phi, 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, &
8083# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8084!$acc& s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, &
8085# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8086!$acc& vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
8087# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8088#elif defined(MFC_OpenMP)
8089# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8090
8091# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8092
8093# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8094
8095# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8096!$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, &
8097# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8098!$omp& 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, &
8099# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8100!$omp& Cv_L, Cv_R, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, &
8101# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8102!$omp& pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
8103# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8104!$omp& Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
8105# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8106#endif
8107# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8108# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8109 do l = is1%beg, is1%end
8110# 898 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8111 do k = is2%beg, is2%end
8112# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8113 do j = is3%beg, is3%end
8114# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8115 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8116 rho_l = 0._wp; rho_r = 0._wp
8117 gamma_l = 0._wp; gamma_r = 0._wp
8118 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8119 qv_l = 0._wp; qv_r = 0._wp
8120 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8121
8122
8123# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8124#if defined(MFC_OpenACC)
8125# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8126!$acc loop seq
8127# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8128#elif defined(MFC_OpenMP)
8129# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8130
8131# 907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8132#endif
8133# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8134 do i = 1, num_fluids
8135 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8136# 910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8137 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8138# 911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8139 end do
8140
8141
8142# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8143#if defined(MFC_OpenACC)
8144# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8145!$acc loop seq
8146# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8147#elif defined(MFC_OpenMP)
8148# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8149
8150# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8151#endif
8152# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8153 do i = 1, num_dims
8154 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8155# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8156 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
8157# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8158 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8159 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8160 end do
8161
8162 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8163# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8164 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
8165# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8166
8167# 955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8168
8169 ! Change this by splitting it into the cases present in the bubbles_euler
8170 if (mpp_lim) then
8171
8172# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8173#if defined(MFC_OpenACC)
8174# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8175!$acc loop seq
8176# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8177#elif defined(MFC_OpenMP)
8178# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8179
8180# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8181#endif
8182# 959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8183 do i = 1, num_fluids
8184 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8185# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8186 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8187# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8188 & eqn_idx%E + i)), 1._wp)
8189 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
8190# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8191 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
8192# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8193 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
8194# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8195 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8196# 967 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8197 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8198# 968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8199 end do
8200
8201
8202# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8203#if defined(MFC_OpenACC)
8204# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8205!$acc loop seq
8206# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8207#elif defined(MFC_OpenMP)
8208# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8209
8210# 970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8211#endif
8212# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8213 do i = 1, num_fluids
8214 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8215# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8216 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8217 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
8218# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8219 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8220 end do
8221 end if
8222
8223 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
8224 ! downstream
8225
8226# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8227#if defined(MFC_OpenACC)
8228# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8229!$acc loop seq
8230# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8231#elif defined(MFC_OpenMP)
8232# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8233
8234# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8235#endif
8236# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8237 do i = 1, num_fluids
8238 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
8239# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8240 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
8241# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8242 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8243# 986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8244 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8245# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8246 end do
8247
8248 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
8249 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
8250
8251 if (viscous) then
8252 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
8253 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
8254 end if
8255
8256 if (chemistry) then
8257 c_sum_yi_phi = 0.0_wp
8258
8259# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8260#if defined(MFC_OpenACC)
8261# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8262!$acc loop seq
8263# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8264#elif defined(MFC_OpenMP)
8265# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8266
8267# 999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8268#endif
8269# 1000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8270 do i = eqn_idx%species%beg, eqn_idx%species%end
8271 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8272# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8273 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
8274# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8275 end do
8276
8277 call get_mixture_molecular_weight(ys_l, mw_l)
8278 call get_mixture_molecular_weight(ys_r, mw_r)
8279
8280 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
8281 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
8282
8283 r_gas_l = gas_constant/mw_l
8284 r_gas_r = gas_constant/mw_r
8285
8286 t_l = pres_l/rho_l/r_gas_l
8287 t_r = pres_r/rho_r/r_gas_r
8288
8289 call get_mixture_caloric_state(t_l, ys_l, cp_il, cp_l, cv_l, e_l)
8290 call get_mixture_caloric_state(t_r, ys_r, cp_ir, cp_r, cv_r, e_r)
8291
8292 if (chem_params%gamma_method == 1) then
8293 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8294 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
8295 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
8296
8297 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
8298 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
8299 else if (chem_params%gamma_method == 2) then
8300 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8301 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8302 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8303 end if
8304
8305 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8306 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8307 h_l = (e_l + pres_l)/rho_l
8308 h_r = (e_r + pres_r)/rho_r
8309 else
8310 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
8311 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
8312
8313 h_l = (e_l + pres_l)/rho_l
8314 h_r = (e_r + pres_r)/rho_r
8315 end if
8316
8317# 1065 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8318 h_l = (e_l + pres_l)/rho_l
8319 h_r = (e_r + pres_r)/rho_r
8320# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8321
8322 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
8323 ! average costs eight square roots per face.
8324 if (wave_speeds == wave_speeds_pressure) then
8325 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
8326 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
8327 if (chemistry .and. avg_state == avg_state_roe) then
8328 r_species(1:num_species) = gas_constant/molecular_weights
8329 call get_species_enthalpies_rt(t_l, h_il)
8330 call get_species_enthalpies_rt(t_r, h_ir)
8331 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
8332 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
8333 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
8334 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
8335 & gamma_avg, c_sum_yi_phi)
8336 end if
8337 end if
8338
8339 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
8340
8341 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
8342
8343 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
8344 ! costs eight square roots per face under the Roe average.
8345 if (wave_speeds == wave_speeds_pressure) then
8346 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
8347 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
8348 & alpha_rho_r)
8349 end if
8350
8351 if (viscous) then
8352 if (chemistry) then
8353 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8354 end if
8355
8356# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8357#if defined(MFC_OpenACC)
8358# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8359!$acc loop seq
8360# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8361#elif defined(MFC_OpenMP)
8362# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8363
8364# 1102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8365#endif
8366# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8367 do i = 1, 2
8368 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8369# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8370 end do
8371 end if
8372
8373 ! Low Mach correction
8374 if (low_mach == 2) then
8375 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
8376 & vel_r(dir_idx(1)))
8377 end if
8378
8379 if (wave_speeds == wave_speeds_direct) then
8380# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8381 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8382 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8383 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8384 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
8385 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
8386# 1136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8387 else if (wave_speeds == wave_speeds_pressure) then
8388 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8389
8390 pres_sr = pres_sl
8391
8392 ! Low Mach correction: Thornber et al. JCP (2008)
8393 ms_l = max(1._wp, &
8394 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
8395 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
8396 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
8397 ms_r = max(1._wp, &
8398 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
8399 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
8400 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
8401
8402 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8403 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8404
8405 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8406 end if
8407
8408 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8409 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8410
8411 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8412 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8413 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8414 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
8415 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8416 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8417
8418 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8419 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8420 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8421
8422 ! Low Mach correction
8423 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
8424 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
8425
8426# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8427
8428 ! COMPUTING THE HLLC FLUXES MASS FLUX.
8429
8430# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8431#if defined(MFC_OpenACC)
8432# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8433!$acc loop seq
8434# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8435#elif defined(MFC_OpenMP)
8436# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8437
8438# 1195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8439#endif
8440# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8441 do i = 1, eqn_idx%cont%end
8442 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8443# 1198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8444 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8445# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8446 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8447 end do
8448
8449# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8450
8451# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8452#if defined(MFC_OpenACC)
8453# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8454!$acc loop seq
8455# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8456#elif defined(MFC_OpenMP)
8457# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8458
8459# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8460#endif
8461# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8462 do i = 1, num_dims
8463 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
8464 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
8465 flux_rsx_vf(j, k, l, &
8466# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8467 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
8468 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
8469 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
8470 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
8471 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
8472 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
8473 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8474 end do
8475
8476 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
8477 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
8478 flux_rsx_vf(j, k, l, &
8479# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8480 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
8481 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
8482 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
8483 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
8484 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
8485# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8486
8487 ! VOLUME FRACTION FLUX.
8488
8489# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8490#if defined(MFC_OpenACC)
8491# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8492!$acc loop seq
8493# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8494#elif defined(MFC_OpenMP)
8495# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8496
8497# 1358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8498#endif
8499# 1359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8500 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8501 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8502# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8503 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8504# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8505 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8506 end do
8507
8508 ! VOLUME FRACTION SOURCE FLUX.
8509
8510# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8511#if defined(MFC_OpenACC)
8512# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8513!$acc loop seq
8514# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8515#elif defined(MFC_OpenMP)
8516# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8517
8518# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8519#endif
8520# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8521 do i = 1, num_dims
8522 vel_src_rsx_vf(j, k, l, &
8523# 1369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8524 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8525 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8526 end do
8527
8528 ! COLOR FUNCTION FLUX
8529 if (surface_tension) then
8530 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
8531# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8532 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8533 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8534# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8535 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8536 end if
8537
8538 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8539# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8540
8541 if (chemistry) then
8542
8543# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8544#if defined(MFC_OpenACC)
8545# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8546!$acc loop seq
8547# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8548#elif defined(MFC_OpenMP)
8549# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8550
8551# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8552#endif
8553# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8554 do i = eqn_idx%species%beg, eqn_idx%species%end
8555 y_l = ql_prim_rsx_vf(j, k, l, i)
8556# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8557 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
8558# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8559
8560 flux_rsx_vf(j, k, l, &
8561# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8562 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8563 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8564 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
8565# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8566 end do
8567 end if
8568
8569# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8570
8571 ! Geometrical source flux for cylindrical coordinates
8572# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8573# 1573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8574 if (grid_geometry == 3) then
8575
8576# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8577#if defined(MFC_OpenACC)
8578# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8579!$acc loop seq
8580# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8581#elif defined(MFC_OpenMP)
8582# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8583
8584# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8585#endif
8586# 1575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8587 do i = 1, sys_size
8588 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
8589# 1577 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8590 end do
8591
8592 flux_gsrc_rsx_vf(j, k, l, &
8593# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8594 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
8595 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
8596 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
8597 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, &
8598# 1584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8599 & eqn_idx%mom%beg + 1)
8600 end if
8601# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8602 end do
8603 end do
8604 end do
8605
8606# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8607#if defined(MFC_OpenACC)
8608# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8609!$acc end parallel loop
8610# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8611#elif defined(MFC_OpenMP)
8612# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8613
8614# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8615!$omp end target teams loop
8616# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8617#endif
8618# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8619# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8620 end if
8621 end if
8622# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8623 ! Computing HLLC flux and source flux for Euler system of equations
8624
8625 if (viscous) then
8626 if (weno_re_flux) then
8627 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8628 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8629 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8630 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8631 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8632 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8633 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8634 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
8635 & norm_dir, ix, iy, iz)
8636 else
8637 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8638 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8639 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8640 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8641 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8642 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8643 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8644 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
8645 & norm_dir, ix, iy, iz)
8646 end if
8647 end if
8648
8649 if (surface_tension) then
8650 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
8651 end if
8652
8653 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
8654
8655 end subroutine s_hllc_riemann_solver
8656
8657end module m_riemann_solver_hllc
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:356
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:396
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:396
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:396
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged model.
Definition m_bubbles.fpp.f90:356
m_bubbles::f_cpbw_km
real(wp) function f_cpbw_km(fr0, fr, fv, fpb)
Keller-Miksis bubble wall pressure.
Definition m_bubbles.fpp.f90:649
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:368
m_chemistry::compute_viscosity_and_inversion
subroutine compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l, re_r)
Compute mixture viscosities for left and right states and invert them for use as reciprocal Reynolds ...
Definition m_chemistry.fpp.f90:411
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_5eq
integer, parameter model_eqns_5eq
Definition m_constants.fpp.f90:155
m_constants::avg_state_roe
integer, parameter avg_state_roe
Definition m_constants.fpp.f90:138
m_constants::wave_speeds_direct
integer, parameter wave_speeds_direct
Definition m_constants.fpp.f90:176
m_constants::riemann_solver_hll
integer, parameter riemann_solver_hll
Definition m_constants.fpp.f90:169
m_constants::sgm_eps
real(wp), parameter sgm_eps
Segmentation tolerance.
Definition m_constants.fpp.f90:13
m_constants::dflt_real
real(wp), parameter dflt_real
Default real value.
Definition m_constants.fpp.f90:12
m_constants::riemann_solver_hllc
integer, parameter riemann_solver_hllc
Definition m_constants.fpp.f90:170
m_constants::wave_speeds_pressure
integer, parameter wave_speeds_pressure
Definition m_constants.fpp.f90:177
m_constants::riemann_solver_lax_friedrichs
integer, parameter riemann_solver_lax_friedrichs
Definition m_constants.fpp.f90:172
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
m_constants::small_alf
real(wp), parameter small_alf
Small alf tolerance.
Definition m_constants.fpp.f90:15
m_constants::verysmall
real(wp), parameter verysmall
Very small number.
Definition m_constants.fpp.f90:17
m_constants::avg_state_arithmetic
integer, parameter avg_state_arithmetic
Definition m_constants.fpp.f90:139
m_constants::model_eqns_6eq
integer, parameter model_eqns_6eq
Definition m_constants.fpp.f90:156
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:402
m_eos::s_phase_pressure_on_isentrope
subroutine, public s_phase_pressure_on_isentrope(pres, rho, xi, i, p_isen)
Pressure of phase i after the isentropic density change rho -> xi rho: closed form for the constant-c...
Definition m_eos.fpp.f90:1567
m_eos::s_compute_speed_of_sound_avg
subroutine, public s_compute_speed_of_sound_avg(pres, rho, gamma, pi_inf, qv, vel_sum, h, c_c, adv, c, alpha_rho)
Speed of sound of an interface-averaged state. An average of two states is not a state - its enthalpy...
Definition m_eos.fpp.f90:2284
m_eos::s_phase_internal_energy
subroutine, public s_phase_internal_energy(pres, alpha, alpha_rho, i, e_phase)
Internal energy per unit volume of phase i at pressure pres: alpha (Gamma p + Pi) + alpha_rho qv,...
Definition m_eos.fpp.f90:1733
m_eos::f_isentrope_pressure
real(wp) function, public f_isentrope_pressure(pi_inf, gamma)
Reference pressure of that isentrope. Precomputed per fluid as isentrope_B.
Definition m_eos.fpp.f90:1179
m_eos::s_compute_mixture_coefficients
subroutine, public s_compute_mixture_coefficients(alpha_rho_k, alpha_k, rho_k, gamma_k, pi_inf_k, qv_k)
Mixture coefficients of one state. Under bubbles_euler with num_fluids == 1 the sole advection slot a...
Definition m_eos.fpp.f90:1980
m_eos::s_compute_speed_of_sound
subroutine, public s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c, alpha_rho)
Speed of sound of a thermodynamic state. Enthalpy is not an argument: for a real state H,...
Definition m_eos.fpp.f90:2153
m_eos::f_isentrope_exponent
real(wp) function, public f_isentrope_exponent(gamma)
Exponent of the stiffened-gas isentrope p + B = const rho**n. Precomputed per fluid as isentrope_n.
Definition m_eos.fpp.f90:1132
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:410
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:951
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:834
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
(nn, nt, nt2) stress indices for wave speeds and momentum flux
Definition m_global_parameters.fpp.f90:836
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:952
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:835
m_global_parameters::stress_perm
integer, dimension(6) stress_perm
Full tensor permutation: local basis -> physical storage index.
Definition m_global_parameters.fpp.f90:837
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:934
m_riemann_solver_hllc
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solver_hllc.fpp.f90:367
m_riemann_solver_hllc::s_hllc_riemann_solver
subroutine s_hllc_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solver_hllc.fpp.f90:391
m_riemann_state
Shared Riemann-solver module state and the per-sweep setup, state-buffer population,...
Definition m_riemann_state.fpp.f90:368
m_riemann_state::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_state.fpp.f90:381
m_riemann_state::isz
type(int_bounds_info) isz
Definition m_riemann_state.fpp.f90:520
m_riemann_state::s_compute_average_state
subroutine s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
Interface-averaged state that the pressure-based wave-speed estimate reads. avg_state selects between...
Definition m_riemann_state.fpp.f90:836
m_riemann_state::f_elastic_signal_speed
real(wp) function f_elastic_signal_speed(c, g, tau, rho)
Elastic signal speed of Rodriguez et al. JCP (2019): the acoustic speed stiffened by the shear modulu...
Definition m_riemann_state.fpp.f90:569
m_riemann_state::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_state.fpp.f90:489
m_riemann_state::isx
type(int_bounds_info) isx
Definition m_riemann_state.fpp.f90:520
m_riemann_state::is3
type(int_bounds_info) is3
Definition m_riemann_state.fpp.f90:519
m_riemann_state::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_state.fpp.f90:381
m_riemann_state::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_state.fpp.f90:550
m_riemann_state::s_compute_chemistry_average_state
subroutine s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, h_il, h_ir, cp_il, cp_ir, vel_avg_rms, gamma_avg, c_sum_yi_phi)
Roe-averaged reacting-mixture quantities: replaces gamma_avg with the mixture Cp/Cv and builds the c_...
Definition m_riemann_state.fpp.f90:940
m_riemann_state::f_low_mach_pcorr_hllc
real(wp) function f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, vel_l_norm, vel_r_norm)
The same correction for the HLLC flux, where the star state supplies the pressure jump directly and t...
Definition m_riemann_state.fpp.f90:720
m_riemann_state::s_initialize_riemann_solver
subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
Set up the chosen Riemann solver algorithm for the current direction.
Definition m_riemann_state.fpp.f90:2178
m_riemann_state::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, q_prim_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_state.fpp.f90:1023
m_riemann_state::nc_iface_vel_rsx_vf
real(wp), dimension(:,:,:,:), allocatable nc_iface_vel_rsx_vf
Definition m_riemann_state.fpp.f90:413
m_riemann_state::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_state.fpp.f90:536
m_riemann_state::s_populate_riemann_states_variables_buffers
subroutine s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
Populate the left and right Riemann state variable buffers based on boundary conditions.
Definition m_riemann_state.fpp.f90:1045
m_riemann_state::s_compute_hypoelastic_interface_energy
subroutine s_compute_hypoelastic_interface_energy(nf, alpha_l, alpha_r, damage_l, damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
Accumulate the hypoelastic stress contribution to the energies of the left and right Riemann states: ...
Definition m_riemann_state.fpp.f90:3263
m_riemann_state::isy
type(int_bounds_info) isy
Definition m_riemann_state.fpp.f90:520
m_riemann_state::f_compute_hllc_star_momentum_flux
real(wp) function f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l_norm, vel_r_norm, s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, dir_flg_norm)
Compute the advective part of the HLLC star-state momentum flux in the wave-normal direction (pressur...
Definition m_riemann_state.fpp.f90:3371
m_riemann_state::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_state.fpp.f90:475
m_riemann_state::is2
type(int_bounds_info) is2
Definition m_riemann_state.fpp.f90:519
m_riemann_state::s_finalize_riemann_solver
subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
Reshape and copy the Riemann-solver flux buffers back to the physical-space output arrays for the sel...
Definition m_riemann_state.fpp.f90:3432
m_riemann_state::s_compute_interface_reynolds
subroutine s_compute_interface_reynolds(alpha_k, re_k, re_size_loc1, re_size_loc2)
Compute the shear and volume Reynolds numbers of one Riemann state by inverse-weighting the fluid Rey...
Definition m_riemann_state.fpp.f90:3170
m_riemann_state::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_state.fpp.f90:399
m_riemann_state::s_apply_low_mach_velocity
subroutine s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l_norm, vel_r_norm)
The alternative low-Mach treatment of Thornber et al. JCP (2008) selected by low_Mach == 2: rather th...
Definition m_riemann_state.fpp.f90:778
m_riemann_state::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_state.fpp.f90:503
m_riemann_state::is1
type(int_bounds_info) is1
Definition m_riemann_state.fpp.f90:519
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:367
m_surface_tension::s_compute_capillary_source_flux
subroutine, public s_compute_capillary_source_flux(vsrc_rsx_vf, flux_src_vf, id, isx, isy, isz)
Definition m_surface_tension.fpp.f90:707
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:367
m_variables_conversion::s_compute_energy
subroutine, public s_compute_energy(pres, alpha_rho_k, alpha_k, vel_sum, e)
Total energy per unit volume, thermodynamic terms only. Callers add magnetic and elastic energy,...
Definition m_variables_conversion.fpp.f90:2424
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:450
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:370