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# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44
45# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46
47# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48
49# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50! New line at end of file is required for FYPP
51# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
52# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
53# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
54# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83! New line at end of file is required for FYPP
84# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
85
86# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162! New line at end of file is required for FYPP
163# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
164# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
165# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
166# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183
184# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
185
186# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187
188# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
189
190# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
191
192# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
193
194# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
195! New line at end of file is required for FYPP
196# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
197
198# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241
242# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
243
244# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253! New line at end of file is required for FYPP
254# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
255
256! GPU parallel region (scalar reductions, maxval/minval)
257# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! GPU parallel loop over threads (most common GPU macro)
260# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Required closing for GPU_PARALLEL_LOOP
263# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Mark routine for device compilation
266# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Declare device-resident data
269# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Inner loop within a GPU parallel region
272# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Scoped GPU data region
275# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Host code with device pointers (for MPI with GPU buffers)
278# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Allocate device memory (unscoped)
281# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Free device memory
284# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Atomic operation on device
287# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! End atomic capture block
290# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Copy data between host and device
293# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Synchronization barrier
296# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Import GPU library module (openacc or omp_lib)
299# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Emit code only for AMD compiler
302# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Emit code for non-Cray compilers
305# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Emit code only for Cray compiler
308# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code for non-NVIDIA compilers
311# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
314# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315! New line at end of file is required for FYPP
316# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
317
318# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
321! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
322! example see misc/nvidia_uvm/bind.sh.
323# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325! Allocate and create GPU device memory
326# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328! Free GPU device memory and deallocate
329# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
330
331! Cray-specific GPU pointer setup for vector fields
332# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Cray-specific GPU pointer setup for scalar fields
335# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Cray-specific GPU pointer setup for acoustic source spatials
338# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
341
342# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
343! New line at end of file is required for FYPP
344# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
345
346module m_riemann_solver_hllc
347
348 use m_derived_types
349 use m_global_parameters
350 use m_variables_conversion
351 use m_eos
352 use m_bubbles
353 use m_constants, only: riemann_solver_hll, riemann_solver_hllc, riemann_solver_lax_friedrichs, model_eqns_5eq, &
354 & model_eqns_6eq, avg_state_roe, avg_state_arithmetic, wave_speeds_direct, wave_speeds_pressure
355 use m_bubbles_ee
356 use m_surface_tension
357 use m_chemistry
358 use m_thermochem, only: gas_constant, get_mixture_molecular_weight, get_mixture_specific_heat_cv_mass, &
359 & get_mixture_energy_mass, get_species_specific_heats_r, get_species_enthalpies_rt, get_mixture_specific_heat_cp_mass, &
360 & molecular_weights
361 use m_riemann_state
362
363 implicit none
364
365contains
366
367 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
368 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, &
369 & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
370 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
371
372 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
373 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
374 type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf
375 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
376 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
377
378 ! Intercell fluxes
379 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
380 integer, intent(in) :: norm_dir
381 type(int_bounds_info), intent(in) :: ix, iy, iz
382
383# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
384 real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R
385 real(wp), dimension(num_fluids) :: alpha_L, alpha_R
386 !> Post-limiter volume fractions (alpha_L/R retain the pre-limiter loads used downstream)
387 real(wp), dimension(num_fluids) :: alpha_lim_L, alpha_lim_R
388 real(wp), dimension(num_dims) :: vel_L, vel_R
389# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
390
391 real(wp) :: rho_L, rho_R
392 real(wp) :: pres_L, pres_R
393 real(wp) :: E_L, E_R
394 real(wp) :: H_L, H_R
395# 67 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
396 real(wp), dimension(num_species) :: Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, R_species, h_iL, h_iR
397# 69 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
398 real(wp) :: c_sum_Yi_Phi
399 real(wp) :: T_L, T_R
400 real(wp) :: MW_L, MW_R
401 real(wp) :: R_gas_L, R_gas_R
402 real(wp) :: Cp_L, Cp_R
403 real(wp) :: Cv_L, Cv_R
404 real(wp) :: Gamm_L, Gamm_R
405 real(wp) :: Y_L, Y_R
406 real(wp) :: gamma_L, gamma_R
407 real(wp) :: pi_inf_L, pi_inf_R
408 real(wp) :: qv_L, qv_R
409 real(wp) :: c_L, c_R
410 real(wp), dimension(2) :: Re_L, Re_R
411 real(wp) :: rho_avg
412 real(wp) :: H_avg
413 real(wp) :: gamma_avg
414 real(wp) :: qv_avg
415 real(wp) :: c_avg
416 real(wp) :: s_L, s_R, s_M, s_P, s_S
417 real(wp) :: xi_L, xi_R !< Left and right wave speeds functions
418 real(wp) :: xi_L_m1, xi_R_m1 !< xi_L/R - 1, computed without cancellation
419 real(wp) :: xi_M, xi_P
420 real(wp) :: xi_MP, xi_PP
421# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
422 real(wp), dimension(nb) :: R0_L, R0_R
423 real(wp), dimension(nb) :: V0_L, V0_R
424 real(wp), dimension(nb) :: P0_L, P0_R
425 real(wp), dimension(nb) :: pbw_L, pbw_R
426# 103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
427
428 real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L, nbub_R
429 real(wp) :: ptilde_L, ptilde_R
430 real(wp) :: PbwR3Lbar, PbwR3Rbar
431 real(wp) :: R3Lbar, R3Rbar
432 real(wp) :: R3V2Lbar, R3V2Rbar
433 real(wp), dimension(6) :: tau_e_L, tau_e_R
434 real(wp) :: G_L, G_R
435 real(wp) :: damage_L, damage_R
436 real(wp) :: solid_partial_density_L, solid_partial_density_R
437 real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms
438 real(wp) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_star
439 real(wp) :: alpha_K_star, alpha_rho_K_star, p_isen_L, p_isen_R, e_K_star
440 real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R
441 real(wp) :: pcorr !< low Mach number correction
442 integer :: i, j, k, l, q !< Generic loop iterators
443 integer :: Re_size_loc1, Re_size_loc2 !< host copy of Re_size; amdflang reads the declare-target original stale cross-TU
444
445 ! HLLC star-state helpers
446# 126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
447 real(wp), dimension(sys_size) :: U_L, U_R
448 real(wp), dimension(sys_size) :: F_L, F_R, F_star_L, F_star_R, F_HLLC
449# 129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
450 real(wp) :: u_n_HLLC, u_t_HLLC, u_t2_HLLC
451 real(wp) :: pres_tot_L, pres_tot_R
452 real(wp) :: u_n_L, u_n_R, u_t_L, u_t_R
453 real(wp) :: u_t2_L, u_t2_R
454 real(wp) :: tau_nn_L, tau_nn_R, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R
455 real(wp) :: tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R
456 real(wp) :: tau_qq_L, tau_qq_R
457 real(wp) :: p_face, tau_qq_face
458 real(wp) :: A_L, A_R, denom_A
459 real(wp) :: u_t_star, tau_nt_star
460 real(wp) :: u_t2_star, tau_nt2_star
461 real(wp) :: pres_tot_star
462 integer :: idx_phys
463
464 ! ADC (HLL -> HLLC)
465# 147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
466 real(wp), dimension(sys_size) :: F_HLL
467# 149 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
468 real(wp) :: u_n_HLL_trace, u_t_HLL_trace
469 real(wp) :: u_t2_HLL_trace
470 real(wp) :: p_face_HLL, tau_qq_face_HLL, tau_nn_HLL
471 real(wp) :: phi
472 real(wp) :: Sigma_L, Sigma_R, dSigma, Sigma_ref
473 real(wp) :: a_L_ref, a_R_ref, a_ref
474 real(wp) :: du_t, dtau_nt
475 real(wp) :: du_t2, dtau_nt2
476 real(wp) :: sensor_ptot, sensor_vt, sensor_tnt, sensor_combined
477 real(wp), parameter :: ADC_power = 1.0_wp
478
479 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
480
481 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
482 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
483
484 ! Reshaping inputted data based on dimensional splitting direction
485
486 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
487
488 re_size_loc1 = re_size(1); re_size_loc2 = re_size(2)
489
490# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
491# 176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
492# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
493 if (norm_dir == 1) then
494 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
495 if (model_eqns == model_eqns_6eq) then
496 ! 6-equation model (model_eqns=3): separate phasic internal energies
497
498# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
499
500# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
501#if defined(MFC_OpenACC)
502# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
503!$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, &
504# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
505!$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, &
506# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
507!$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, &
508# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
509!$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, &
510# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
511!$acc& p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
512# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
513#elif defined(MFC_OpenMP)
514# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
515
516# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
517
518# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
519
520# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
521!$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, &
522# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
523!$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, &
524# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
525!$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, &
526# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
527!$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, &
528# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
529!$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)
530# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
531#endif
532# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
533 do l = is3%beg, is3%end
534 do k = is2%beg, is2%end
535 do j = is1%beg, is1%end
536 vel_l_rms = 0._wp; vel_r_rms = 0._wp
537 rho_l = 0._wp; rho_r = 0._wp
538 gamma_l = 0._wp; gamma_r = 0._wp
539 pi_inf_l = 0._wp; pi_inf_r = 0._wp
540 qv_l = 0._wp; qv_r = 0._wp
541 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
542
543
544# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
545#if defined(MFC_OpenACC)
546# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
547!$acc loop seq
548# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
549#elif defined(MFC_OpenMP)
550# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
551
552# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
553#endif
554 do i = 1, num_dims
555 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
556 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
557 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
558 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
559 end do
560
561 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
562 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
563
564 rho_l = 0._wp
565 gamma_l = 0._wp
566 pi_inf_l = 0._wp
567 qv_l = 0._wp
568
569 rho_r = 0._wp
570 gamma_r = 0._wp
571 pi_inf_r = 0._wp
572 qv_r = 0._wp
573
574 alpha_l_sum = 0._wp
575 alpha_r_sum = 0._wp
576
577 if (mpp_lim) then
578
579# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
580#if defined(MFC_OpenACC)
581# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
582!$acc loop seq
583# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
584#elif defined(MFC_OpenMP)
585# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
586
587# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
588#endif
589 do i = 1, num_fluids
590 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
591 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
592 & eqn_idx%E + i)), 1._wp)
593 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
594 end do
595
596
597# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
598#if defined(MFC_OpenACC)
599# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
600!$acc loop seq
601# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
602#elif defined(MFC_OpenMP)
603# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
604
605# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
606#endif
607 do i = 1, num_fluids
608 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
609 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
610 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
611 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
612 end do
613
614
615# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
616#if defined(MFC_OpenACC)
617# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
618!$acc loop seq
619# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
620#elif defined(MFC_OpenMP)
621# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
622
623# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
624#endif
625 do i = 1, num_fluids
626 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
627 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
628 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
629 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
630 end do
631 end if
632
633
634# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
635#if defined(MFC_OpenACC)
636# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
637!$acc loop seq
638# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
639#elif defined(MFC_OpenMP)
640# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
641
642# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
643#endif
644 do i = 1, num_fluids
645 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
646 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
647 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
648 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
649 end do
650
651 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
652 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
653
654 if (viscous) then
655 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
656 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
657 end if
658
659 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
660 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
661
662 h_l = (e_l + pres_l)/rho_l
663 h_r = (e_r + pres_r)/rho_r
664
665 ! Only the Roe path writes this, and chemistry is unreachable at model_eqns = 6eq; zero it
666 ! so the sound speed below never reads an undefined value.
667 c_sum_yi_phi = 0._wp
668
669 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
670 ! average costs eight square roots per face.
671 if (wave_speeds == wave_speeds_pressure) then
672 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, &
673 & qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
674 end if
675
676 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
677
678 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
679
680 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
681 ! costs eight square roots per face under the Roe average.
682 if (wave_speeds == wave_speeds_pressure) then
683 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
684 & h_avg, c_sum_yi_phi, alpha_r, c_avg, alpha_rho_r)
685 end if
686
687 if (viscous) then
688
689# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
690#if defined(MFC_OpenACC)
691# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
692!$acc loop seq
693# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
694#elif defined(MFC_OpenMP)
695# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
696
697# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
698#endif
699 do i = 1, 2
700 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
701 end do
702 end if
703
704 ! Low Mach correction
705 if (low_mach == 2) then
706 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
707 & vel_r(dir_idx(1)))
708 end if
709
710 ! COMPUTING THE DIRECT WAVE SPEEDS
711 if (wave_speeds == wave_speeds_direct) then
712 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
713 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
714 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
715 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
716 & - rho_r*(s_r - vel_r(dir_idx(1))))
717 else if (wave_speeds == wave_speeds_pressure) then
718 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
719
720 pres_sr = pres_sl
721
722 ! Low Mach correction: Thornber et al. JCP (2008)
723 ms_l = max(1._wp, &
724 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
725 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
726 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
727 ms_r = max(1._wp, &
728 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
729 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
730 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
731
732 s_l = vel_l(dir_idx(1)) - c_l*ms_l
733 s_r = vel_r(dir_idx(1)) + c_r*ms_r
734
735 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
736 end if
737
738 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
739 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
740
741 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
742 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
743 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
744 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
745 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
746
747 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
748 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
749 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
750
751 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
752 xi_mp = -min(0._wp, sign(1._wp, s_l))
753 xi_pp = max(0._wp, sign(1._wp, s_r))
754
755 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 &
756 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
757 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
758 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
759 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
760
761 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))
762
763 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 &
764 & - vel_r(dir_idx(1)))
765
766 ! Low Mach correction
767 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
768 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
769
770 ! COMPUTING FLUXES MASS FLUX.
771
772# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
773#if defined(MFC_OpenACC)
774# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
775!$acc loop seq
776# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
777#elif defined(MFC_OpenMP)
778# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
779
780# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
781#endif
782 do i = 1, eqn_idx%cont%end
783 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
784 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
785 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
786 end do
787
788 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
789
790# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
791#if defined(MFC_OpenACC)
792# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
793!$acc loop seq
794# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
795#elif defined(MFC_OpenMP)
796# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
797
798# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
799#endif
800 do i = 1, num_dims
801 flux_rsx_vf(j, k, l, &
802 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
803 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
804 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
805 & *dir_flg(dir_idx(i))*pcorr
806 end do
807
808 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
809 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
810
811 ! VOLUME FRACTION FLUX.
812
813# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
814#if defined(MFC_OpenACC)
815# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
816!$acc loop seq
817# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
818#elif defined(MFC_OpenMP)
819# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
820
821# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
822#endif
823 do i = eqn_idx%adv%beg, eqn_idx%adv%end
824 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
825 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
826 end do
827
828 ! Advection velocity source: interface velocity for volume fraction transport
829
830# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
831#if defined(MFC_OpenACC)
832# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
833!$acc loop seq
834# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
835#elif defined(MFC_OpenMP)
836# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
837
838# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
839#endif
840 do i = 1, num_dims
841 vel_src_rsx_vf(j, k, l, &
842 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
843 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
844 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
845 end do
846
847 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
848 ! energy flux
849
850# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
851#if defined(MFC_OpenACC)
852# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
853!$acc loop seq
854# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
855#elif defined(MFC_OpenMP)
856# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
857
858# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
859#endif
860 do i = 1, num_fluids
861 ! Phasic isentrope p* from the upwind state: closed form for stiffened gas, integrated
862 ! for a state-dependent EOS.
863 call s_phase_pressure_on_isentrope(pres_l, alpha_rho_l(i)/max(alpha_l(i), sgm_eps), xi_l, i, &
864 & p_isen_l)
865 call s_phase_pressure_on_isentrope(pres_r, alpha_rho_r(i)/max(alpha_r(i), sgm_eps), xi_r, i, &
866 & p_isen_r)
867 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)
868
869 alpha_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
870 & i + eqn_idx%adv%beg - 1) &
871 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
872 & i + eqn_idx%adv%beg - 1)
873 alpha_rho_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
874 & i + eqn_idx%cont%beg - 1) &
875 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
876 & i + eqn_idx%cont%beg - 1)
877 ! Star partial density xi_K alpha_rho, blended like p_K_Star: a state-dependent EOS reads
878 ! its coefficients at the star density, not the upwind one.
879 call s_phase_internal_energy(p_k_star, alpha_k_star, &
880 & alpha_rho_k_star*(1._wp + xi_m*xi_mp*(xi_l - 1._wp) &
881 & + xi_p*xi_pp*(xi_r - 1._wp)), i, e_k_star)
882 flux_rsx_vf(j, k, l, &
883 & i + eqn_idx%int_en%beg - 1) = e_k_star*vel_k_star + (s_m/s_l)*(s_p/s_r) &
884 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
885 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
886 & i + eqn_idx%adv%beg - 1))
887 end do
888
889 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
890
891 ! COLOR FUNCTION FLUX
892 if (surface_tension) then
893 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
894 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
895 end if
896
897 ! Geometrical source flux for cylindrical coordinates
898# 468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
899# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
900 end do
901 end do
902 end do
903
904# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
905#if defined(MFC_OpenACC)
906# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
907!$acc end parallel loop
908# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
909#elif defined(MFC_OpenMP)
910# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
911
912# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
913!$omp end target teams loop
914# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
915#endif
916 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
917 ! 5-equation model with Euler-Euler bubble dynamics
918
919# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
920
921# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
922#if defined(MFC_OpenACC)
923# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
924!$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, &
925# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
926!$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, &
927# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
928!$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, &
929# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
930!$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)
931# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
932#elif defined(MFC_OpenMP)
933# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
934
935# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
936
937# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
938
939# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
940!$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, &
941# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
942!$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, &
943# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
944!$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, &
945# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
946!$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) &
947# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
948!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
949# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
950#endif
951# 495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
952 do l = is3%beg, is3%end
953 do k = is2%beg, is2%end
954 do j = is1%beg, is1%end
955 vel_l_rms = 0._wp; vel_r_rms = 0._wp
956 rho_l = 0._wp; rho_r = 0._wp
957 gamma_l = 0._wp; gamma_r = 0._wp
958 pi_inf_l = 0._wp; pi_inf_r = 0._wp
959 qv_l = 0._wp; qv_r = 0._wp
960
961
962# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
963#if defined(MFC_OpenACC)
964# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
965!$acc loop seq
966# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
967#elif defined(MFC_OpenMP)
968# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
969
970# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
971#endif
972 do i = 1, num_fluids
973 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
974 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
975 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
976 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
977 end do
978
979 vel_l_rms = 0._wp; vel_r_rms = 0._wp
980
981
982# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
983#if defined(MFC_OpenACC)
984# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
985!$acc loop seq
986# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
987#elif defined(MFC_OpenMP)
988# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
989
990# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
991#endif
992 do i = 1, num_dims
993 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
994 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
995 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
996 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
997 end do
998
999 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
1000 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
1001
1002 if (viscous) then
1003 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
1004
1005# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1006#if defined(MFC_OpenACC)
1007# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1008!$acc loop seq
1009# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1010#elif defined(MFC_OpenMP)
1011# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1012
1013# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1014#endif
1015 do i = 1, 2
1016 re_l(i) = dflt_real
1017 re_r(i) = dflt_real
1018
1019 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
1020 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
1021
1022
1023# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1024#if defined(MFC_OpenACC)
1025# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1026!$acc loop seq
1027# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1028#elif defined(MFC_OpenMP)
1029# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1030
1031# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1032#endif
1033 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
1034 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
1035 & q)))/res_gs(i, q) + re_l(i)
1036 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
1037 & q)))/res_gs(i, q) + re_r(i)
1038 end do
1039
1040 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1041 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1042 end do
1043 end if
1044 end if
1045
1046 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1047 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1048
1049 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
1050 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
1051
1052 h_l = (e_l + pres_l)/rho_l
1053 h_r = (e_r + pres_r)/rho_r
1054
1055 if (avg_state == avg_state_arithmetic) then
1056
1057# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1058#if defined(MFC_OpenACC)
1059# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1060!$acc loop seq
1061# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1062#elif defined(MFC_OpenMP)
1063# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1064
1065# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1066#endif
1067 do i = 1, nb
1068 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
1069 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
1070
1071 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
1072 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
1073 if (.not. polytropic .and. .not. qbmm) then
1074 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
1075 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
1076 end if
1077 end do
1078
1079 if (.not. qbmm) then
1080 if (adv_n) then
1081 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
1082 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
1083 else
1084 nbub_l = 0._wp
1085 nbub_r = 0._wp
1086
1087# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1088#if defined(MFC_OpenACC)
1089# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1090!$acc loop seq
1091# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1092#elif defined(MFC_OpenMP)
1093# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1094
1095# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1096#endif
1097 do i = 1, nb
1098 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
1099 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
1100 end do
1101
1102 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
1103 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
1104 & eqn_idx%E + num_fluids)/nbub_r
1105 end if
1106 else
1107 ! nb stored in 0th moment of first R0 bin in variable conversion module
1108 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
1109 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
1110 end if
1111
1112
1113# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1114#if defined(MFC_OpenACC)
1115# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1116!$acc loop seq
1117# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1118#elif defined(MFC_OpenMP)
1119# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1120
1121# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1122#endif
1123 do i = 1, nb
1124 if (.not. qbmm) then
1125 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
1126 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
1127 end if
1128 end do
1129
1130 if (qbmm) then
1131 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
1132 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
1133
1134 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
1135 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
1136
1137 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
1138 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
1139 else
1140 pbwr3lbar = 0._wp
1141 pbwr3rbar = 0._wp
1142
1143 r3lbar = 0._wp
1144 r3rbar = 0._wp
1145
1146 r3v2lbar = 0._wp
1147 r3v2rbar = 0._wp
1148
1149
1150# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1151#if defined(MFC_OpenACC)
1152# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1153!$acc loop seq
1154# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1155#elif defined(MFC_OpenMP)
1156# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1157
1158# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1159#endif
1160 do i = 1, nb
1161 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
1162 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
1163
1164 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
1165 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
1166
1167 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
1168 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
1169 end do
1170 end if
1171
1172 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1173 h_avg = 5.e-1_wp*(h_l + h_r)
1174 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1175 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1176 vel_avg_rms = 0._wp
1177
1178
1179# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1180#if defined(MFC_OpenACC)
1181# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1182!$acc loop seq
1183# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1184#elif defined(MFC_OpenMP)
1185# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1186
1187# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1188#endif
1189 do i = 1, num_dims
1190 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1191 end do
1192 end if
1193
1194 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
1195
1196 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
1197
1198 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
1199 ! costs eight square roots per face under the Roe average.
1200 if (wave_speeds == wave_speeds_pressure) then
1201 ! Zero, not c_sum_Yi_Phi: this loop never forms the chemistry average, and
1202 ! chemistry with bubbles_euler/qbmm is prohibited, so the branch is unreachable.
1203 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
1204 & h_avg, 0._wp, alpha_r, c_avg, alpha_rho_r)
1205 end if
1206
1207 if (viscous) then
1208
1209# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1210#if defined(MFC_OpenACC)
1211# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1212!$acc loop seq
1213# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1214#elif defined(MFC_OpenMP)
1215# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1216
1217# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1218#endif
1219 do i = 1, 2
1220 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1221 end do
1222 end if
1223
1224 ! Low Mach correction
1225 if (low_mach == 2) then
1226 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
1227 & vel_r(dir_idx(1)))
1228 end if
1229
1230 if (wave_speeds == wave_speeds_direct) then
1231 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1232 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1233
1234 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1235 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1236 & - rho_r*(s_r - vel_r(dir_idx(1))))
1237 else if (wave_speeds == wave_speeds_pressure) then
1238 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1239
1240 pres_sr = pres_sl
1241
1242 ! Low Mach correction: Thornber et al. JCP (2008)
1243 ms_l = max(1._wp, &
1244 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
1245 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
1246 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
1247 ms_r = max(1._wp, &
1248 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
1249 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
1250 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
1251
1252 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1253 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1254
1255 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1256 end if
1257
1258 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1259 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1260
1261 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1262 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1263 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1264 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1265 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1266
1267 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1268 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1269 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1270
1271 ! Low Mach correction
1272 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
1273 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
1274
1275
1276# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1277#if defined(MFC_OpenACC)
1278# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1279!$acc loop seq
1280# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1281#elif defined(MFC_OpenMP)
1282# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1283
1284# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1285#endif
1286 do i = 1, eqn_idx%cont%end
1287 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1288 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1289 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1290 end do
1291
1292 if (bubbles_euler .and. (num_fluids > 1)) then
1293 ! Kill mass transport @ gas density
1294 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
1295 end if
1296
1297 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1298
1299 ! Include p_tilde
1300
1301 if (avg_state == avg_state_arithmetic) then
1302 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
1303 pres_l = pres_l - alpha_l(num_fluids)*pres_l
1304 else
1305 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
1306 end if
1307
1308 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
1309 pres_r = pres_r - alpha_r(num_fluids)*pres_r
1310 else
1311 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
1312 end if
1313 end if
1314
1315
1316# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1317#if defined(MFC_OpenACC)
1318# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1319!$acc loop seq
1320# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1321#elif defined(MFC_OpenMP)
1322# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1323
1324# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1325#endif
1326 do i = 1, num_dims
1327 flux_rsx_vf(j, k, l, &
1328 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
1329 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1330 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
1331 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1332 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1333 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
1334 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
1335 end do
1336
1337 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
1338 flux_rsx_vf(j, k, l, &
1339 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
1340 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
1341 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
1342 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
1343 & *pcorr*s_s
1344
1345 ! Volume fraction flux
1346
1347# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1348#if defined(MFC_OpenACC)
1349# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1350!$acc loop seq
1351# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1352#elif defined(MFC_OpenMP)
1353# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1354
1355# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1356#endif
1357 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1358 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1359 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1360 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1361 end do
1362
1363 ! Advection velocity source: interface velocity for volume fraction transport
1364
1365# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1366#if defined(MFC_OpenACC)
1367# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1368!$acc loop seq
1369# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1370#elif defined(MFC_OpenMP)
1371# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1372
1373# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1374#endif
1375 do i = 1, num_dims
1376 vel_src_rsx_vf(j, k, l, &
1377 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
1378 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
1379 end do
1380
1381 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1382
1383 ! Add advection flux for bubble variables
1384
1385# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1386#if defined(MFC_OpenACC)
1387# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1388!$acc loop seq
1389# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1390#elif defined(MFC_OpenMP)
1391# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1392
1393# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1394#endif
1395 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1396 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
1397 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1398 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1399 end do
1400
1401 if (qbmm) then
1402 flux_rsx_vf(j, k, l, &
1403 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1404 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1405 end if
1406
1407 if (adv_n) then
1408 flux_rsx_vf(j, k, l, &
1409 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1410 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1411 end if
1412
1413 ! Geometrical source flux for cylindrical coordinates
1414# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1415# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1416 end do
1417 end do
1418 end do
1419
1420# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1421#if defined(MFC_OpenACC)
1422# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1423!$acc end parallel loop
1424# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1425#elif defined(MFC_OpenMP)
1426# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1427
1428# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1429!$omp end target teams loop
1430# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1431#endif
1432# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1433# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1434 else if (hypoelasticity) then
1435# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1436 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
1437 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
1438 ! statement and private variable from the pure-fluid emission, keeping its body and directive
1439 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
1440 ! pinned it at the GPU register ceiling for every HLLC user.
1441 ! One source of truth for this kernel's private variables: both emissions of the shared body take
1442 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
1443 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
1444 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
1445# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1446# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1447# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1448# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1449# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1450# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1451# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1452# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1453# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1454# 880 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1455# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1456# 884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1457# 885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1458# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1459# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1460 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
1461 ! both emissions the same name; amdflang then launches the wrong one and a
1462 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
1463 ! give two line numbers. Do not merge them back into one.
1464# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1465
1466# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1467
1468# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1469#if defined(MFC_OpenACC)
1470# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1471!$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, &
1472# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1473!$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, &
1474# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1475!$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, &
1476# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1477!$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, &
1478# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1479!$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, &
1480# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1481!$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, &
1482# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1483!$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, &
1484# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1485!$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)
1486# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1487#elif defined(MFC_OpenMP)
1488# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1489
1490# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1491
1492# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1493
1494# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1495!$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, &
1496# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1497!$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, &
1498# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1499!$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, &
1500# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1501!$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, &
1502# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1503!$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, &
1504# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1505!$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, &
1506# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1507!$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, &
1508# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1509!$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, &
1510# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1511!$omp& sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
1512# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1513#endif
1514# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1515# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1516 do l = is3%beg, is3%end
1517 do k = is2%beg, is2%end
1518 do j = is1%beg, is1%end
1519 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1520 rho_l = 0._wp; rho_r = 0._wp
1521 gamma_l = 0._wp; gamma_r = 0._wp
1522 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1523 qv_l = 0._wp; qv_r = 0._wp
1524 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
1525
1526
1527# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1528#if defined(MFC_OpenACC)
1529# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1530!$acc loop seq
1531# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1532#elif defined(MFC_OpenMP)
1533# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1534
1535# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1536#endif
1537 do i = 1, num_fluids
1538 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1539 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1540 end do
1541
1542
1543# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1544#if defined(MFC_OpenACC)
1545# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1546!$acc loop seq
1547# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1548#elif defined(MFC_OpenMP)
1549# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1550
1551# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1552#endif
1553 do i = 1, num_dims
1554 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1555 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1556 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1557 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1558 end do
1559
1560 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1561 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1562
1563# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1564
1565# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1566#if defined(MFC_OpenACC)
1567# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1568!$acc loop seq
1569# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1570#elif defined(MFC_OpenMP)
1571# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1572
1573# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1574#endif
1575 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1576 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1577 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
1578 end do
1579
1580 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
1581 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
1582 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
1583 if (n > 0) then
1584 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
1585 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
1586 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
1587 end if
1588 if (p > 0) then
1589 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
1590 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
1591 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
1592 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
1593 end if
1594 pres_tot_l = pres_l - tau_nn_l
1595 pres_tot_r = pres_r - tau_nn_r
1596 if (cyl_coord) then
1597 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1598 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1599 else
1600 tau_qq_l = 0._wp
1601 tau_qq_r = 0._wp
1602 end if
1603# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1604
1605 ! Change this by splitting it into the cases present in the bubbles_euler
1606 if (mpp_lim) then
1607
1608# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1609#if defined(MFC_OpenACC)
1610# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1611!$acc loop seq
1612# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1613#elif defined(MFC_OpenMP)
1614# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1615
1616# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1617#endif
1618 do i = 1, num_fluids
1619 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
1620 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
1621 & eqn_idx%E + i)), 1._wp)
1622 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
1623 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
1624 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
1625 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1626 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1627 end do
1628
1629
1630# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1631#if defined(MFC_OpenACC)
1632# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1633!$acc loop seq
1634# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1635#elif defined(MFC_OpenMP)
1636# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1637
1638# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1639#endif
1640 do i = 1, num_fluids
1641 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
1642 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
1643 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
1644 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
1645 end do
1646 end if
1647
1648 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
1649 ! downstream
1650
1651# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1652#if defined(MFC_OpenACC)
1653# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1654!$acc loop seq
1655# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1656#elif defined(MFC_OpenMP)
1657# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1658
1659# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1660#endif
1661 do i = 1, num_fluids
1662 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1663 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1664 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1665 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1666 end do
1667
1668 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
1669 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
1670
1671 if (viscous) then
1672 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
1673 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
1674 end if
1675
1676 if (chemistry) then
1677 c_sum_yi_phi = 0.0_wp
1678
1679# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1680#if defined(MFC_OpenACC)
1681# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1682!$acc loop seq
1683# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1684#elif defined(MFC_OpenMP)
1685# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1686
1687# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1688#endif
1689 do i = eqn_idx%species%beg, eqn_idx%species%end
1690 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
1691 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
1692 end do
1693
1694 call get_mixture_molecular_weight(ys_l, mw_l)
1695 call get_mixture_molecular_weight(ys_r, mw_r)
1696
1697 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
1698 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
1699
1700 r_gas_l = gas_constant/mw_l
1701 r_gas_r = gas_constant/mw_r
1702
1703 t_l = pres_l/rho_l/r_gas_l
1704 t_r = pres_r/rho_r/r_gas_r
1705
1706 call get_species_specific_heats_r(t_l, cp_il)
1707 call get_species_specific_heats_r(t_r, cp_ir)
1708
1709 if (chem_params%gamma_method == 1) then
1710 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1711 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
1712 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
1713
1714 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
1715 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
1716 else if (chem_params%gamma_method == 2) then
1717 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1718 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1719 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1720 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1721 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1722
1723 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
1724 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1725 end if
1726
1727 call get_mixture_energy_mass(t_l, ys_l, e_l)
1728 call get_mixture_energy_mass(t_r, ys_r, e_r)
1729
1730 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1731 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1732 h_l = (e_l + pres_l)/rho_l
1733 h_r = (e_r + pres_r)/rho_r
1734 else
1735 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
1736 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
1737
1738 h_l = (e_l + pres_l)/rho_l
1739 h_r = (e_r + pres_r)/rho_r
1740 end if
1741
1742# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1743 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
1744
1745# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1746#if defined(MFC_OpenACC)
1747# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1748!$acc loop seq
1749# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1750#elif defined(MFC_OpenMP)
1751# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1752
1753# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1754#endif
1755 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1756 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1757 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
1758 end do
1759 damage_l = 0._wp; damage_r = 0._wp
1760 if (cont_damage) then
1761 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
1762 damage_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%damage)
1763 end if
1764
1765 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
1766 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
1767 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
1768 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
1769 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
1770 ! keep their pre-adjustment values here.
1771# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1772
1773 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
1774 ! average costs eight square roots per face.
1775 if (wave_speeds == wave_speeds_pressure) then
1776 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
1777 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
1778 if (chemistry .and. avg_state == avg_state_roe) then
1779 r_species(1:num_species) = gas_constant/molecular_weights
1780 call get_species_enthalpies_rt(t_l, h_il)
1781 call get_species_enthalpies_rt(t_r, h_ir)
1782 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
1783 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
1784 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
1785 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
1786 & gamma_avg, c_sum_yi_phi)
1787 end if
1788 end if
1789
1790 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
1791
1792 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
1793
1794 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
1795 ! costs eight square roots per face under the Roe average.
1796 if (wave_speeds == wave_speeds_pressure) then
1797 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
1798 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
1799 & alpha_rho_r)
1800 end if
1801
1802 if (viscous) then
1803 if (chemistry) then
1804 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1805 end if
1806
1807# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1808#if defined(MFC_OpenACC)
1809# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1810!$acc loop seq
1811# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1812#elif defined(MFC_OpenMP)
1813# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1814
1815# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1816#endif
1817 do i = 1, 2
1818 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1819 end do
1820 end if
1821
1822 ! Low Mach correction
1823 if (low_mach == 2) then
1824 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
1825 & vel_r(dir_idx(1)))
1826 end if
1827
1828 if (wave_speeds == wave_speeds_direct) then
1829# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1830 ! Elastic wave speed, Rodriguez et al. JCP (2019)
1831 s_l = min(vel_l(dir_idx(1)) - f_elastic_signal_speed(c_l, g_l, &
1832 & tau_e_l(dir_idx_tau(1)), rho_l), &
1833 & vel_r(dir_idx(1)) - f_elastic_signal_speed(c_r, g_r, &
1834 & tau_e_r(dir_idx_tau(1)), rho_r))
1835 s_r = max(vel_r(dir_idx(1)) + f_elastic_signal_speed(c_r, g_r, &
1836 & tau_e_r(dir_idx_tau(1)), rho_r), &
1837 & vel_l(dir_idx(1)) + f_elastic_signal_speed(c_l, g_l, &
1838 & tau_e_l(dir_idx_tau(1)), rho_l))
1839 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
1840 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
1841 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
1842 & - vel_r(dir_idx(1))))
1843# 1150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1844 else if (wave_speeds == wave_speeds_pressure) then
1845 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1846
1847 pres_sr = pres_sl
1848
1849 ! Low Mach correction: Thornber et al. JCP (2008)
1850 ms_l = max(1._wp, &
1851 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
1852 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
1853 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
1854 ms_r = max(1._wp, &
1855 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
1856 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
1857 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
1858
1859 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1860 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1861
1862 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1863 end if
1864
1865 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1866 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1867
1868 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1869 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1870 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1871 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
1872 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1873 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1874
1875 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1876 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1877 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1878
1879 ! Low Mach correction
1880 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
1881 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
1882
1883# 1190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1884 if (n == 0) then
1885 u_t_l = 0._wp; u_t_r = 0._wp
1886 tau_nt_l = 0._wp; tau_nt_r = 0._wp
1887 end if
1888 if (p == 0) then
1889 u_t2_l = 0._wp; u_t2_r = 0._wp
1890 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
1891 end if
1892 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
1893 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
1894 denom_a = a_r - a_l
1895 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
1896 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
1897 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
1898 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
1899 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
1900# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1901
1902 ! COMPUTING THE HLLC FLUXES MASS FLUX.
1903
1904# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1905#if defined(MFC_OpenACC)
1906# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1907!$acc loop seq
1908# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1909#elif defined(MFC_OpenMP)
1910# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1911
1912# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1913#endif
1914 do i = 1, eqn_idx%cont%end
1915 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1916 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1917 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1918 end do
1919
1920# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1921 flux_rsx_vf(j, k, l, &
1922 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
1923 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
1924 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
1925 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
1926 if (n > 0) then
1927 flux_rsx_vf(j, k, l, &
1928 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
1929 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
1930 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
1931 & - tau_nt_r)
1932 end if
1933 if (p > 0) then
1934 flux_rsx_vf(j, k, l, &
1935 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
1936 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
1937 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
1938 & - tau_nt2_r)
1939 end if
1940
1941 flux_rsx_vf(j, k, l, &
1942 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
1943 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
1944 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
1945 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
1946 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
1947 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
1948 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
1949 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
1950 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
1951 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
1952
1953 if (n == 0) then
1954 flux_rsx_vf(j, k, l, &
1955 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
1956 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
1957 & + s_p*(xi_r - 1._wp))
1958 else if (p == 0) then
1959 if (dir_idx(1) == 1) then
1960 flux_rsx_vf(j, k, l, &
1961 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
1962 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
1963 & + s_p*(xi_r - 1._wp))
1964 flux_rsx_vf(j, k, l, &
1965 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
1966 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
1967 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
1968 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
1969 flux_rsx_vf(j, k, l, &
1970 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
1971 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
1972 & + s_p*(xi_r - 1._wp))
1973 else
1974 flux_rsx_vf(j, k, l, &
1975 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
1976 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
1977 & + s_p*(xi_r - 1._wp))
1978 flux_rsx_vf(j, k, l, &
1979 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
1980 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
1981 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
1982 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
1983 flux_rsx_vf(j, k, l, &
1984 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
1985 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
1986 & + s_p*(xi_r - 1._wp))
1987 end if
1988 else
1989 flux_rsx_vf(j, k, l, &
1990 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
1991 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
1992 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
1993 flux_rsx_vf(j, k, l, &
1994 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
1995 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
1996 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
1997 & - rho_r*tau_nt_r))
1998 flux_rsx_vf(j, k, l, &
1999 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
2000 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
2001 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
2002 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
2003 flux_rsx_vf(j, k, l, &
2004 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
2005 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2006 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2007 flux_rsx_vf(j, k, l, &
2008 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
2009 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2010 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2011 flux_rsx_vf(j, k, l, &
2012 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
2013 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2014 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2015 end if
2016 if (cyl_coord) then
2017 flux_rsx_vf(j, k, l, &
2018 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
2019 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
2020 & + s_p*(xi_r - 1._wp))
2021 end if
2022
2023 ! Damage flux: U_D = m_s*D (damageable-solid partial mass)
2024 if (cont_damage) then
2025 solid_partial_density_l = 0._wp; solid_partial_density_r = 0._wp
2026
2027# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2028#if defined(MFC_OpenACC)
2029# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2030!$acc loop seq
2031# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2032#elif defined(MFC_OpenMP)
2033# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2034
2035# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2036#endif
2037 do i = 1, num_fluids
2038 if (gs_rs(i) > verysmall) then
2039 solid_partial_density_l = solid_partial_density_l + alpha_rho_l(i)
2040 solid_partial_density_r = solid_partial_density_r + alpha_rho_r(i)
2041 end if
2042 end do
2043 flux_rsx_vf(j, k, l, &
2044 & eqn_idx%damage) &
2045 & = xi_m*solid_partial_density_l*damage_l*(vel_l(dir_idx(1)) + s_m*(xi_l &
2046 & - 1._wp)) + xi_p*solid_partial_density_r*damage_r*(vel_r(dir_idx(1)) &
2047 & + s_p*(xi_r - 1._wp))
2048 end if
2049
2050 if (s_l >= 0._wp) then
2051 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
2052 else if (s_r <= 0._wp) then
2053 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
2054 else
2055 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
2056 end if
2057 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2058 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2059 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2060# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2061
2062 ! VOLUME FRACTION FLUX.
2063
2064# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2065#if defined(MFC_OpenACC)
2066# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2067!$acc loop seq
2068# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2069#elif defined(MFC_OpenMP)
2070# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2071
2072# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2073#endif
2074 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2075 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2076 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2077 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2078 end do
2079
2080 ! VOLUME FRACTION SOURCE FLUX.
2081
2082# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2083#if defined(MFC_OpenACC)
2084# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2085!$acc loop seq
2086# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2087#elif defined(MFC_OpenMP)
2088# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2089
2090# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2091#endif
2092 do i = 1, num_dims
2093 vel_src_rsx_vf(j, k, l, &
2094 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2095 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2096 end do
2097
2098 ! COLOR FUNCTION FLUX
2099 if (surface_tension) then
2100 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
2101 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2102 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2103 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2104 end if
2105
2106 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2107
2108 if (chemistry) then
2109
2110# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2111#if defined(MFC_OpenACC)
2112# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2113!$acc loop seq
2114# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2115#elif defined(MFC_OpenMP)
2116# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2117
2118# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2119#endif
2120 do i = eqn_idx%species%beg, eqn_idx%species%end
2121 y_l = ql_prim_rsx_vf(j, k, l, i)
2122 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
2123
2124 flux_rsx_vf(j, k, l, &
2125 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2126 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2127 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
2128 end do
2129 end if
2130
2131# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2132 ! HLLC-ADC blending for hypoelasticity
2133 if (riemann_hypo_adc) then
2134 ! Build U_L, U_R and F_L, F_R in local-basis layout
2135
2136# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2137#if defined(MFC_OpenACC)
2138# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2139!$acc loop seq
2140# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2141#elif defined(MFC_OpenMP)
2142# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2143
2144# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2145#endif
2146 do i = 1, num_fluids
2147 u_l(i) = alpha_rho_l(i)
2148 u_r(i) = alpha_rho_r(i)
2149 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
2150 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
2151 f_l(i) = alpha_rho_l(i)*u_n_l
2152 f_r(i) = alpha_rho_r(i)*u_n_r
2153 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
2154 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
2155 end do
2156
2157 ! Momentum U/F in physical order via dir_idx
2158 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
2159 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
2160 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
2161 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
2162 if (n > 0) then
2163 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
2164 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
2165 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
2166 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
2167 end if
2168 if (p > 0) then
2169 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
2170 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
2171 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
2172 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
2173 end if
2174
2175 u_l(eqn_idx%E) = e_l
2176 u_r(eqn_idx%E) = e_r
2177 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
2178 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
2179
2180 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
2181
2182# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2183#if defined(MFC_OpenACC)
2184# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2185!$acc loop seq
2186# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2187#elif defined(MFC_OpenMP)
2188# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2189
2190# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2191#endif
2192 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
2193 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
2194 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
2195 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
2196 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
2197 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
2198 end do
2199 if (cyl_coord) then
2200 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
2201 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
2202 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
2203 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
2204 end if
2205
2206 ! Compute F_HLL (physical order) and HLL trace velocities
2207 if (s_l >= 0._wp) then
2208
2209# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2210#if defined(MFC_OpenACC)
2211# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2212!$acc loop seq
2213# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2214#elif defined(MFC_OpenMP)
2215# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2216
2217# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2218#endif
2219 do i = 1, sys_size
2220 f_hll(i) = f_l(i)
2221 end do
2222 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
2223 else if (s_r <= 0._wp) then
2224
2225# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2226#if defined(MFC_OpenACC)
2227# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2228!$acc loop seq
2229# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2230#elif defined(MFC_OpenMP)
2231# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2232
2233# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2234#endif
2235 do i = 1, sys_size
2236 f_hll(i) = f_r(i)
2237 end do
2238 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
2239 else
2240
2241# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2242#if defined(MFC_OpenACC)
2243# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2244!$acc loop seq
2245# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2246#elif defined(MFC_OpenMP)
2247# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2248
2249# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2250#endif
2251 do i = 1, sys_size
2252 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 &
2253 & + verysmall)
2254 end do
2255 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
2256 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
2257 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
2258 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
2259 end if
2260
2261 ! ADC sensor
2262 sigma_l = pres_tot_l
2263 sigma_r = pres_tot_r
2264 dsigma = sigma_r - sigma_l
2265 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
2266
2267 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
2268 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
2269 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
2270
2271 du_t = u_t_r - u_t_l
2272 dtau_nt = tau_nt_r - tau_nt_l
2273 du_t2 = u_t2_r - u_t2_l
2274 dtau_nt2 = tau_nt2_r - tau_nt2_l
2275
2276 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
2277 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
2278 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
2279 & + verysmall)
2280
2281 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
2282 phi = exp(-(sensor_combined**adc_power))
2283
2284 ! Blend all flux components: F_HLL is in physical order
2285
2286# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2287#if defined(MFC_OpenACC)
2288# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2289!$acc loop seq
2290# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2291#elif defined(MFC_OpenMP)
2292# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2293
2294# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2295#endif
2296 do i = 1, sys_size
2297 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
2298 end do
2299
2300 ! Blend interface velocities (scalar HLL traces)
2301 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
2302 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
2303 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
2304
2305 ! Overwrite vel_src with blended velocities
2306 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2307 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2308 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2309
2310 ! Update advection source flux with ADC-blended face-normal velocity
2311 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
2312
2313 ! Overwrite nc_iface_vel with blended velocities
2314 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2315 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2316 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2317 end if
2318 ! END HLLC-ADC
2319# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2320
2321 ! Geometrical source flux for cylindrical coordinates
2322# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2323# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2324 end do
2325 end do
2326 end do
2327
2328# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2329#if defined(MFC_OpenACC)
2330# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2331!$acc end parallel loop
2332# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2333#elif defined(MFC_OpenMP)
2334# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2335
2336# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2337!$omp end target teams loop
2338# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2339#endif
2340# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2341# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2342 else
2343# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2344 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
2345 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
2346 ! statement and private variable from the pure-fluid emission, keeping its body and directive
2347 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
2348 ! pinned it at the GPU register ceiling for every HLLC user.
2349 ! One source of truth for this kernel's private variables: both emissions of the shared body take
2350 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
2351 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
2352 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
2353# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2354# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2355# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2356# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2357# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2358# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2359# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2360# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2361# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2362# 880 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2363# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2364# 884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2365# 889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2366# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2367# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2368 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
2369 ! both emissions the same name; amdflang then launches the wrong one and a
2370 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
2371 ! give two line numbers. Do not merge them back into one.
2372# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2373
2374# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2375
2376# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2377#if defined(MFC_OpenACC)
2378# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2379!$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, &
2380# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2381!$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, &
2382# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2383!$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, &
2384# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2385!$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)
2386# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2387#elif defined(MFC_OpenMP)
2388# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2389
2390# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2391
2392# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2393
2394# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2395!$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, &
2396# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2397!$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, &
2398# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2399!$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, &
2400# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2401!$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, &
2402# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2403!$omp& Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
2404# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2405#endif
2406# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2407# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2408 do l = is3%beg, is3%end
2409 do k = is2%beg, is2%end
2410 do j = is1%beg, is1%end
2411 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2412 rho_l = 0._wp; rho_r = 0._wp
2413 gamma_l = 0._wp; gamma_r = 0._wp
2414 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2415 qv_l = 0._wp; qv_r = 0._wp
2416 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2417
2418
2419# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2420#if defined(MFC_OpenACC)
2421# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2422!$acc loop seq
2423# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2424#elif defined(MFC_OpenMP)
2425# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2426
2427# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2428#endif
2429 do i = 1, num_fluids
2430 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2431 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2432 end do
2433
2434
2435# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2436#if defined(MFC_OpenACC)
2437# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2438!$acc loop seq
2439# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2440#elif defined(MFC_OpenMP)
2441# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2442
2443# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2444#endif
2445 do i = 1, num_dims
2446 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2447 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
2448 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2449 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2450 end do
2451
2452 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2453 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
2454
2455# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2456
2457 ! Change this by splitting it into the cases present in the bubbles_euler
2458 if (mpp_lim) then
2459
2460# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2461#if defined(MFC_OpenACC)
2462# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2463!$acc loop seq
2464# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2465#elif defined(MFC_OpenMP)
2466# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2467
2468# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2469#endif
2470 do i = 1, num_fluids
2471 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2472 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2473 & eqn_idx%E + i)), 1._wp)
2474 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
2475 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
2476 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
2477 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2478 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2479 end do
2480
2481
2482# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2483#if defined(MFC_OpenACC)
2484# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2485!$acc loop seq
2486# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2487#elif defined(MFC_OpenMP)
2488# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2489
2490# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2491#endif
2492 do i = 1, num_fluids
2493 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2494 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2495 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
2496 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2497 end do
2498 end if
2499
2500 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
2501 ! downstream
2502
2503# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2504#if defined(MFC_OpenACC)
2505# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2506!$acc loop seq
2507# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2508#elif defined(MFC_OpenMP)
2509# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2510
2511# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2512#endif
2513 do i = 1, num_fluids
2514 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2515 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
2516 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2517 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2518 end do
2519
2520 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
2521 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
2522
2523 if (viscous) then
2524 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
2525 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
2526 end if
2527
2528 if (chemistry) then
2529 c_sum_yi_phi = 0.0_wp
2530
2531# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2532#if defined(MFC_OpenACC)
2533# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2534!$acc loop seq
2535# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2536#elif defined(MFC_OpenMP)
2537# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2538
2539# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2540#endif
2541 do i = eqn_idx%species%beg, eqn_idx%species%end
2542 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2543 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
2544 end do
2545
2546 call get_mixture_molecular_weight(ys_l, mw_l)
2547 call get_mixture_molecular_weight(ys_r, mw_r)
2548
2549 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
2550 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
2551
2552 r_gas_l = gas_constant/mw_l
2553 r_gas_r = gas_constant/mw_r
2554
2555 t_l = pres_l/rho_l/r_gas_l
2556 t_r = pres_r/rho_r/r_gas_r
2557
2558 call get_species_specific_heats_r(t_l, cp_il)
2559 call get_species_specific_heats_r(t_r, cp_ir)
2560
2561 if (chem_params%gamma_method == 1) then
2562 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2563 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
2564 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
2565
2566 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
2567 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
2568 else if (chem_params%gamma_method == 2) then
2569 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2570 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2571 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2572 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2573 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2574
2575 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
2576 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2577 end if
2578
2579 call get_mixture_energy_mass(t_l, ys_l, e_l)
2580 call get_mixture_energy_mass(t_r, ys_r, e_r)
2581
2582 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2583 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2584 h_l = (e_l + pres_l)/rho_l
2585 h_r = (e_r + pres_r)/rho_r
2586 else
2587 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
2588 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
2589
2590 h_l = (e_l + pres_l)/rho_l
2591 h_r = (e_r + pres_r)/rho_r
2592 end if
2593
2594# 1079 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2595 h_l = (e_l + pres_l)/rho_l
2596 h_r = (e_r + pres_r)/rho_r
2597# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2598
2599 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
2600 ! average costs eight square roots per face.
2601 if (wave_speeds == wave_speeds_pressure) then
2602 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
2603 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
2604 if (chemistry .and. avg_state == avg_state_roe) then
2605 r_species(1:num_species) = gas_constant/molecular_weights
2606 call get_species_enthalpies_rt(t_l, h_il)
2607 call get_species_enthalpies_rt(t_r, h_ir)
2608 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
2609 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
2610 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
2611 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
2612 & gamma_avg, c_sum_yi_phi)
2613 end if
2614 end if
2615
2616 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
2617
2618 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
2619
2620 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
2621 ! costs eight square roots per face under the Roe average.
2622 if (wave_speeds == wave_speeds_pressure) then
2623 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
2624 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
2625 & alpha_rho_r)
2626 end if
2627
2628 if (viscous) then
2629 if (chemistry) then
2630 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2631 end if
2632
2633# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2634#if defined(MFC_OpenACC)
2635# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2636!$acc loop seq
2637# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2638#elif defined(MFC_OpenMP)
2639# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2640
2641# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2642#endif
2643 do i = 1, 2
2644 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2645 end do
2646 end if
2647
2648 ! Low Mach correction
2649 if (low_mach == 2) then
2650 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
2651 & vel_r(dir_idx(1)))
2652 end if
2653
2654 if (wave_speeds == wave_speeds_direct) then
2655# 1144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2656 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2657 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2658 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2659 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
2660 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
2661# 1150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2662 else if (wave_speeds == wave_speeds_pressure) then
2663 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2664
2665 pres_sr = pres_sl
2666
2667 ! Low Mach correction: Thornber et al. JCP (2008)
2668 ms_l = max(1._wp, &
2669 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
2670 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
2671 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
2672 ms_r = max(1._wp, &
2673 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
2674 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
2675 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
2676
2677 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2678 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2679
2680 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2681 end if
2682
2683 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2684 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2685
2686 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2687 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2688 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2689 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
2690 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2691 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2692
2693 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2694 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2695 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2696
2697 ! Low Mach correction
2698 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
2699 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
2700
2701# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2702
2703 ! COMPUTING THE HLLC FLUXES MASS FLUX.
2704
2705# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2706#if defined(MFC_OpenACC)
2707# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2708!$acc loop seq
2709# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2710#elif defined(MFC_OpenMP)
2711# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2712
2713# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2714#endif
2715 do i = 1, eqn_idx%cont%end
2716 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2717 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2718 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2719 end do
2720
2721# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2722
2723# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2724#if defined(MFC_OpenACC)
2725# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2726!$acc loop seq
2727# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2728#elif defined(MFC_OpenMP)
2729# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2730
2731# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2732#endif
2733 do i = 1, num_dims
2734 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
2735 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
2736 flux_rsx_vf(j, k, l, &
2737 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
2738 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
2739 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
2740 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2741 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
2742 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
2743 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
2744 end do
2745
2746 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
2747 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
2748 flux_rsx_vf(j, k, l, &
2749 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
2750 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
2751 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
2752 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
2753 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
2754# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2755
2756 ! VOLUME FRACTION FLUX.
2757
2758# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2759#if defined(MFC_OpenACC)
2760# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2761!$acc loop seq
2762# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2763#elif defined(MFC_OpenMP)
2764# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2765
2766# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2767#endif
2768 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2769 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2770 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2771 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2772 end do
2773
2774 ! VOLUME FRACTION SOURCE FLUX.
2775
2776# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2777#if defined(MFC_OpenACC)
2778# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2779!$acc loop seq
2780# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2781#elif defined(MFC_OpenMP)
2782# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2783
2784# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2785#endif
2786 do i = 1, num_dims
2787 vel_src_rsx_vf(j, k, l, &
2788 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2789 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2790 end do
2791
2792 ! COLOR FUNCTION FLUX
2793 if (surface_tension) then
2794 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
2795 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2796 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2797 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2798 end if
2799
2800 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2801
2802 if (chemistry) then
2803
2804# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2805#if defined(MFC_OpenACC)
2806# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2807!$acc loop seq
2808# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2809#elif defined(MFC_OpenMP)
2810# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2811
2812# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2813#endif
2814 do i = eqn_idx%species%beg, eqn_idx%species%end
2815 y_l = ql_prim_rsx_vf(j, k, l, i)
2816 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
2817
2818 flux_rsx_vf(j, k, l, &
2819 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2820 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2821 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
2822 end do
2823 end if
2824
2825# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2826
2827 ! Geometrical source flux for cylindrical coordinates
2828# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2829# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2830 end do
2831 end do
2832 end do
2833
2834# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2835#if defined(MFC_OpenACC)
2836# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2837!$acc end parallel loop
2838# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2839#elif defined(MFC_OpenMP)
2840# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2841
2842# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2843!$omp end target teams loop
2844# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2845#endif
2846# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2847 end if
2848 end if
2849# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2850# 176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2851# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2852 if (norm_dir == 2) then
2853 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
2854 if (model_eqns == model_eqns_6eq) then
2855 ! 6-equation model (model_eqns=3): separate phasic internal energies
2856
2857# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2858
2859# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2860#if defined(MFC_OpenACC)
2861# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2862!$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, &
2863# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2864!$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, &
2865# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2866!$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, &
2867# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2868!$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, &
2869# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2870!$acc& p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
2871# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2872#elif defined(MFC_OpenMP)
2873# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2874
2875# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2876
2877# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2878
2879# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2880!$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, &
2881# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2882!$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, &
2883# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2884!$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, &
2885# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2886!$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, &
2887# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2888!$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)
2889# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2890#endif
2891# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2892 do l = is3%beg, is3%end
2893 do k = is1%beg, is1%end
2894 do j = is2%beg, is2%end
2895 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2896 rho_l = 0._wp; rho_r = 0._wp
2897 gamma_l = 0._wp; gamma_r = 0._wp
2898 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2899 qv_l = 0._wp; qv_r = 0._wp
2900 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2901
2902
2903# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2904#if defined(MFC_OpenACC)
2905# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2906!$acc loop seq
2907# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2908#elif defined(MFC_OpenMP)
2909# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2910
2911# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2912#endif
2913 do i = 1, num_dims
2914 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2915 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
2916 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2917 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2918 end do
2919
2920 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2921 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
2922
2923 rho_l = 0._wp
2924 gamma_l = 0._wp
2925 pi_inf_l = 0._wp
2926 qv_l = 0._wp
2927
2928 rho_r = 0._wp
2929 gamma_r = 0._wp
2930 pi_inf_r = 0._wp
2931 qv_r = 0._wp
2932
2933 alpha_l_sum = 0._wp
2934 alpha_r_sum = 0._wp
2935
2936 if (mpp_lim) then
2937
2938# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2939#if defined(MFC_OpenACC)
2940# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2941!$acc loop seq
2942# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2943#elif defined(MFC_OpenMP)
2944# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2945
2946# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2947#endif
2948 do i = 1, num_fluids
2949 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2950 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2951 & eqn_idx%E + i)), 1._wp)
2952 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2953 end do
2954
2955
2956# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2957#if defined(MFC_OpenACC)
2958# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2959!$acc loop seq
2960# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2961#elif defined(MFC_OpenMP)
2962# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2963
2964# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2965#endif
2966 do i = 1, num_fluids
2967 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
2968 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
2969 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
2970 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
2971 end do
2972
2973
2974# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2975#if defined(MFC_OpenACC)
2976# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2977!$acc loop seq
2978# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2979#elif defined(MFC_OpenMP)
2980# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2981
2982# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2983#endif
2984 do i = 1, num_fluids
2985 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2986 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2987 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
2988 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2989 end do
2990 end if
2991
2992
2993# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2994#if defined(MFC_OpenACC)
2995# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2996!$acc loop seq
2997# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2998#elif defined(MFC_OpenMP)
2999# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3000
3001# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3002#endif
3003 do i = 1, num_fluids
3004 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3005 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3006 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
3007 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
3008 end do
3009
3010 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
3011 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
3012
3013 if (viscous) then
3014 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
3015 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
3016 end if
3017
3018 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
3019 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
3020
3021 h_l = (e_l + pres_l)/rho_l
3022 h_r = (e_r + pres_r)/rho_r
3023
3024 ! Only the Roe path writes this, and chemistry is unreachable at model_eqns = 6eq; zero it
3025 ! so the sound speed below never reads an undefined value.
3026 c_sum_yi_phi = 0._wp
3027
3028 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
3029 ! average costs eight square roots per face.
3030 if (wave_speeds == wave_speeds_pressure) then
3031 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, &
3032 & qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
3033 end if
3034
3035 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
3036
3037 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
3038
3039 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
3040 ! costs eight square roots per face under the Roe average.
3041 if (wave_speeds == wave_speeds_pressure) then
3042 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
3043 & h_avg, c_sum_yi_phi, alpha_r, c_avg, alpha_rho_r)
3044 end if
3045
3046 if (viscous) then
3047
3048# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3049#if defined(MFC_OpenACC)
3050# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3051!$acc loop seq
3052# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3053#elif defined(MFC_OpenMP)
3054# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3055
3056# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3057#endif
3058 do i = 1, 2
3059 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3060 end do
3061 end if
3062
3063 ! Low Mach correction
3064 if (low_mach == 2) then
3065 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
3066 & vel_r(dir_idx(1)))
3067 end if
3068
3069 ! COMPUTING THE DIRECT WAVE SPEEDS
3070 if (wave_speeds == wave_speeds_direct) then
3071 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3072 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3073 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3074 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3075 & - rho_r*(s_r - vel_r(dir_idx(1))))
3076 else if (wave_speeds == wave_speeds_pressure) then
3077 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3078
3079 pres_sr = pres_sl
3080
3081 ! Low Mach correction: Thornber et al. JCP (2008)
3082 ms_l = max(1._wp, &
3083 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
3084 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
3085 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
3086 ms_r = max(1._wp, &
3087 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
3088 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
3089 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
3090
3091 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3092 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3093
3094 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3095 end if
3096
3097 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3098 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3099
3100 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3101 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3102 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3103 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3104 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3105
3106 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3107 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
3108 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
3109
3110 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
3111 xi_mp = -min(0._wp, sign(1._wp, s_l))
3112 xi_pp = max(0._wp, sign(1._wp, s_r))
3113
3114 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 &
3115 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
3116 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
3117 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
3118 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
3119
3120 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))
3121
3122 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 &
3123 & - vel_r(dir_idx(1)))
3124
3125 ! Low Mach correction
3126 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
3127 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
3128
3129 ! COMPUTING FLUXES MASS FLUX.
3130
3131# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3132#if defined(MFC_OpenACC)
3133# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3134!$acc loop seq
3135# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3136#elif defined(MFC_OpenMP)
3137# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3138
3139# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3140#endif
3141 do i = 1, eqn_idx%cont%end
3142 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3143 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3144 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3145 end do
3146
3147 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
3148
3149# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3150#if defined(MFC_OpenACC)
3151# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3152!$acc loop seq
3153# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3154#elif defined(MFC_OpenMP)
3155# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3156
3157# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3158#endif
3159 do i = 1, num_dims
3160 flux_rsx_vf(j, k, l, &
3161 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
3162 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
3163 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
3164 & *dir_flg(dir_idx(i))*pcorr
3165 end do
3166
3167 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3168 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
3169
3170 ! VOLUME FRACTION FLUX.
3171
3172# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3173#if defined(MFC_OpenACC)
3174# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3175!$acc loop seq
3176# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3177#elif defined(MFC_OpenMP)
3178# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3179
3180# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3181#endif
3182 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3183 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3184 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
3185 end do
3186
3187 ! Advection velocity source: interface velocity for volume fraction transport
3188
3189# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3190#if defined(MFC_OpenACC)
3191# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3192!$acc loop seq
3193# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3194#elif defined(MFC_OpenMP)
3195# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3196
3197# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3198#endif
3199 do i = 1, num_dims
3200 vel_src_rsx_vf(j, k, l, &
3201 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3202 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
3203 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
3204 end do
3205
3206 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
3207 ! energy flux
3208
3209# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3210#if defined(MFC_OpenACC)
3211# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3212!$acc loop seq
3213# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3214#elif defined(MFC_OpenMP)
3215# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3216
3217# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3218#endif
3219 do i = 1, num_fluids
3220 ! Phasic isentrope p* from the upwind state: closed form for stiffened gas, integrated
3221 ! for a state-dependent EOS.
3222 call s_phase_pressure_on_isentrope(pres_l, alpha_rho_l(i)/max(alpha_l(i), sgm_eps), xi_l, i, &
3223 & p_isen_l)
3224 call s_phase_pressure_on_isentrope(pres_r, alpha_rho_r(i)/max(alpha_r(i), sgm_eps), xi_r, i, &
3225 & p_isen_r)
3226 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)
3227
3228 alpha_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
3229 & i + eqn_idx%adv%beg - 1) &
3230 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3231 & i + eqn_idx%adv%beg - 1)
3232 alpha_rho_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
3233 & i + eqn_idx%cont%beg - 1) &
3234 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3235 & i + eqn_idx%cont%beg - 1)
3236 ! Star partial density xi_K alpha_rho, blended like p_K_Star: a state-dependent EOS reads
3237 ! its coefficients at the star density, not the upwind one.
3238 call s_phase_internal_energy(p_k_star, alpha_k_star, &
3239 & alpha_rho_k_star*(1._wp + xi_m*xi_mp*(xi_l - 1._wp) &
3240 & + xi_p*xi_pp*(xi_r - 1._wp)), i, e_k_star)
3241 flux_rsx_vf(j, k, l, &
3242 & i + eqn_idx%int_en%beg - 1) = e_k_star*vel_k_star + (s_m/s_l)*(s_p/s_r) &
3243 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
3244 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3245 & i + eqn_idx%adv%beg - 1))
3246 end do
3247
3248 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3249
3250 ! COLOR FUNCTION FLUX
3251 if (surface_tension) then
3252 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
3253 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
3254 end if
3255
3256 ! Geometrical source flux for cylindrical coordinates
3257# 447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3258 if (cyl_coord) then
3259 ! Substituting the advective flux into the inviscid geometrical source flux
3260
3261# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3262#if defined(MFC_OpenACC)
3263# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3264!$acc loop seq
3265# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3266#elif defined(MFC_OpenMP)
3267# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3268
3269# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3270#endif
3271 do i = 1, eqn_idx%E
3272 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3273 end do
3274
3275# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3276#if defined(MFC_OpenACC)
3277# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3278!$acc loop seq
3279# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3280#elif defined(MFC_OpenMP)
3281# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3282
3283# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3284#endif
3285 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
3286 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3287 end do
3288 ! Recalculating the radial momentum geometric source flux
3289 flux_gsrc_rsx_vf(j, k, l, &
3290 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
3291 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
3292 ! Geometrical source of the void fraction(s) is zero
3293
3294# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3295#if defined(MFC_OpenACC)
3296# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3297!$acc loop seq
3298# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3299#elif defined(MFC_OpenMP)
3300# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3301
3302# 462 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3303#endif
3304 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3305 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
3306 end do
3307 end if
3308# 468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3309# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3310 end do
3311 end do
3312 end do
3313
3314# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3315#if defined(MFC_OpenACC)
3316# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3317!$acc end parallel loop
3318# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3319#elif defined(MFC_OpenMP)
3320# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3321
3322# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3323!$omp end target teams loop
3324# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3325#endif
3326 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
3327 ! 5-equation model with Euler-Euler bubble dynamics
3328
3329# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3330
3331# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3332#if defined(MFC_OpenACC)
3333# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3334!$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, &
3335# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3336!$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, &
3337# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3338!$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, &
3339# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3340!$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)
3341# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3342#elif defined(MFC_OpenMP)
3343# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3344
3345# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3346
3347# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3348
3349# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3350!$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, &
3351# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3352!$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, &
3353# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3354!$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, &
3355# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3356!$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) &
3357# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3358!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
3359# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3360#endif
3361# 495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3362 do l = is3%beg, is3%end
3363 do k = is1%beg, is1%end
3364 do j = is2%beg, is2%end
3365 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3366 rho_l = 0._wp; rho_r = 0._wp
3367 gamma_l = 0._wp; gamma_r = 0._wp
3368 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3369 qv_l = 0._wp; qv_r = 0._wp
3370
3371
3372# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3373#if defined(MFC_OpenACC)
3374# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3375!$acc loop seq
3376# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3377#elif defined(MFC_OpenMP)
3378# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3379
3380# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3381#endif
3382 do i = 1, num_fluids
3383 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3384 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3385 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3386 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3387 end do
3388
3389 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3390
3391
3392# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3393#if defined(MFC_OpenACC)
3394# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3395!$acc loop seq
3396# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3397#elif defined(MFC_OpenMP)
3398# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3399
3400# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3401#endif
3402 do i = 1, num_dims
3403 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3404 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3405 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3406 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3407 end do
3408
3409 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
3410 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
3411
3412 if (viscous) then
3413 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
3414
3415# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3416#if defined(MFC_OpenACC)
3417# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3418!$acc loop seq
3419# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3420#elif defined(MFC_OpenMP)
3421# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3422
3423# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3424#endif
3425 do i = 1, 2
3426 re_l(i) = dflt_real
3427 re_r(i) = dflt_real
3428
3429 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
3430 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
3431
3432
3433# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3434#if defined(MFC_OpenACC)
3435# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3436!$acc loop seq
3437# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3438#elif defined(MFC_OpenMP)
3439# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3440
3441# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3442#endif
3443 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
3444 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
3445 & q)))/res_gs(i, q) + re_l(i)
3446 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
3447 & q)))/res_gs(i, q) + re_r(i)
3448 end do
3449
3450 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3451 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3452 end do
3453 end if
3454 end if
3455
3456 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3457 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3458
3459 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
3460 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
3461
3462 h_l = (e_l + pres_l)/rho_l
3463 h_r = (e_r + pres_r)/rho_r
3464
3465 if (avg_state == avg_state_arithmetic) then
3466
3467# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3468#if defined(MFC_OpenACC)
3469# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3470!$acc loop seq
3471# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3472#elif defined(MFC_OpenMP)
3473# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3474
3475# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3476#endif
3477 do i = 1, nb
3478 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
3479 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
3480
3481 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
3482 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
3483 if (.not. polytropic .and. .not. qbmm) then
3484 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
3485 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
3486 end if
3487 end do
3488
3489 if (.not. qbmm) then
3490 if (adv_n) then
3491 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
3492 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
3493 else
3494 nbub_l = 0._wp
3495 nbub_r = 0._wp
3496
3497# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3498#if defined(MFC_OpenACC)
3499# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3500!$acc loop seq
3501# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3502#elif defined(MFC_OpenMP)
3503# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3504
3505# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3506#endif
3507 do i = 1, nb
3508 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
3509 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
3510 end do
3511
3512 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
3513 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
3514 & eqn_idx%E + num_fluids)/nbub_r
3515 end if
3516 else
3517 ! nb stored in 0th moment of first R0 bin in variable conversion module
3518 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
3519 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
3520 end if
3521
3522
3523# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3524#if defined(MFC_OpenACC)
3525# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3526!$acc loop seq
3527# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3528#elif defined(MFC_OpenMP)
3529# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3530
3531# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3532#endif
3533 do i = 1, nb
3534 if (.not. qbmm) then
3535 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
3536 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
3537 end if
3538 end do
3539
3540 if (qbmm) then
3541 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
3542 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
3543
3544 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
3545 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
3546
3547 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
3548 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
3549 else
3550 pbwr3lbar = 0._wp
3551 pbwr3rbar = 0._wp
3552
3553 r3lbar = 0._wp
3554 r3rbar = 0._wp
3555
3556 r3v2lbar = 0._wp
3557 r3v2rbar = 0._wp
3558
3559
3560# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3561#if defined(MFC_OpenACC)
3562# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3563!$acc loop seq
3564# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3565#elif defined(MFC_OpenMP)
3566# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3567
3568# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3569#endif
3570 do i = 1, nb
3571 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
3572 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
3573
3574 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
3575 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
3576
3577 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
3578 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
3579 end do
3580 end if
3581
3582 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3583 h_avg = 5.e-1_wp*(h_l + h_r)
3584 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3585 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3586 vel_avg_rms = 0._wp
3587
3588
3589# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3590#if defined(MFC_OpenACC)
3591# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3592!$acc loop seq
3593# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3594#elif defined(MFC_OpenMP)
3595# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3596
3597# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3598#endif
3599 do i = 1, num_dims
3600 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3601 end do
3602 end if
3603
3604 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
3605
3606 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
3607
3608 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
3609 ! costs eight square roots per face under the Roe average.
3610 if (wave_speeds == wave_speeds_pressure) then
3611 ! Zero, not c_sum_Yi_Phi: this loop never forms the chemistry average, and
3612 ! chemistry with bubbles_euler/qbmm is prohibited, so the branch is unreachable.
3613 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
3614 & h_avg, 0._wp, alpha_r, c_avg, alpha_rho_r)
3615 end if
3616
3617 if (viscous) then
3618
3619# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3620#if defined(MFC_OpenACC)
3621# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3622!$acc loop seq
3623# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3624#elif defined(MFC_OpenMP)
3625# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3626
3627# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3628#endif
3629 do i = 1, 2
3630 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3631 end do
3632 end if
3633
3634 ! Low Mach correction
3635 if (low_mach == 2) then
3636 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
3637 & vel_r(dir_idx(1)))
3638 end if
3639
3640 if (wave_speeds == wave_speeds_direct) then
3641 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3642 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3643
3644 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3645 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3646 & - rho_r*(s_r - vel_r(dir_idx(1))))
3647 else if (wave_speeds == wave_speeds_pressure) then
3648 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3649
3650 pres_sr = pres_sl
3651
3652 ! Low Mach correction: Thornber et al. JCP (2008)
3653 ms_l = max(1._wp, &
3654 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
3655 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
3656 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
3657 ms_r = max(1._wp, &
3658 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
3659 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
3660 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
3661
3662 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3663 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3664
3665 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3666 end if
3667
3668 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3669 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3670
3671 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3672 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3673 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3674 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3675 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3676
3677 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3678 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
3679 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
3680
3681 ! Low Mach correction
3682 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
3683 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
3684
3685
3686# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3687#if defined(MFC_OpenACC)
3688# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3689!$acc loop seq
3690# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3691#elif defined(MFC_OpenMP)
3692# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3693
3694# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3695#endif
3696 do i = 1, eqn_idx%cont%end
3697 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3698 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3699 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3700 end do
3701
3702 if (bubbles_euler .and. (num_fluids > 1)) then
3703 ! Kill mass transport @ gas density
3704 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
3705 end if
3706
3707 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
3708
3709 ! Include p_tilde
3710
3711 if (avg_state == avg_state_arithmetic) then
3712 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
3713 pres_l = pres_l - alpha_l(num_fluids)*pres_l
3714 else
3715 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
3716 end if
3717
3718 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
3719 pres_r = pres_r - alpha_r(num_fluids)*pres_r
3720 else
3721 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
3722 end if
3723 end if
3724
3725
3726# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3727#if defined(MFC_OpenACC)
3728# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3729!$acc loop seq
3730# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3731#elif defined(MFC_OpenMP)
3732# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3733
3734# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3735#endif
3736 do i = 1, num_dims
3737 flux_rsx_vf(j, k, l, &
3738 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
3739 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
3740 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
3741 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3742 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
3743 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
3744 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
3745 end do
3746
3747 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
3748 flux_rsx_vf(j, k, l, &
3749 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
3750 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
3751 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
3752 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
3753 & *pcorr*s_s
3754
3755 ! Volume fraction flux
3756
3757# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3758#if defined(MFC_OpenACC)
3759# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3760!$acc loop seq
3761# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3762#elif defined(MFC_OpenMP)
3763# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3764
3765# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3766#endif
3767 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3768 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3769 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3770 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3771 end do
3772
3773 ! Advection velocity source: interface velocity for volume fraction transport
3774
3775# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3776#if defined(MFC_OpenACC)
3777# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3778!$acc loop seq
3779# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3780#elif defined(MFC_OpenMP)
3781# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3782
3783# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3784#endif
3785 do i = 1, num_dims
3786 vel_src_rsx_vf(j, k, l, &
3787 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
3788 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
3789 end do
3790
3791 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3792
3793 ! Add advection flux for bubble variables
3794
3795# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3796#if defined(MFC_OpenACC)
3797# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3798!$acc loop seq
3799# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3800#elif defined(MFC_OpenMP)
3801# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3802
3803# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3804#endif
3805 do i = eqn_idx%bub%beg, eqn_idx%bub%end
3806 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
3807 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3808 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3809 end do
3810
3811 if (qbmm) then
3812 flux_rsx_vf(j, k, l, &
3813 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3814 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3815 end if
3816
3817 if (adv_n) then
3818 flux_rsx_vf(j, k, l, &
3819 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3820 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3821 end if
3822
3823 ! Geometrical source flux for cylindrical coordinates
3824# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3825 if (cyl_coord) then
3826 ! Substituting the advective flux into the inviscid geometrical source flux
3827
3828# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3829#if defined(MFC_OpenACC)
3830# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3831!$acc loop seq
3832# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3833#elif defined(MFC_OpenMP)
3834# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3835
3836# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3837#endif
3838 do i = 1, eqn_idx%E
3839 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3840 end do
3841 ! Recalculating the radial momentum geometric source flux
3842 flux_gsrc_rsx_vf(j, k, l, &
3843 & eqn_idx%cont%end + dir_idx(1)) &
3844 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l(dir_idx(1)), &
3845 & vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, &
3846 & dir_flg(dir_idx(1)))
3847 ! Geometrical source of the void fraction(s) is zero
3848
3849# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3850#if defined(MFC_OpenACC)
3851# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3852!$acc loop seq
3853# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3854#elif defined(MFC_OpenMP)
3855# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3856
3857# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3858#endif
3859 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3860 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
3861 end do
3862 end if
3863# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3864# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3865 end do
3866 end do
3867 end do
3868
3869# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3870#if defined(MFC_OpenACC)
3871# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3872!$acc end parallel loop
3873# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3874#elif defined(MFC_OpenMP)
3875# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3876
3877# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3878!$omp end target teams loop
3879# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3880#endif
3881# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3882# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3883 else if (hypoelasticity) then
3884# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3885 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
3886 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
3887 ! statement and private variable from the pure-fluid emission, keeping its body and directive
3888 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
3889 ! pinned it at the GPU register ceiling for every HLLC user.
3890 ! One source of truth for this kernel's private variables: both emissions of the shared body take
3891 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
3892 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
3893 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
3894# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3895# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3896# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3897# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3898# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3899# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3900# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3901# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3902# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3903# 880 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3904# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3905# 884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3906# 885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3907# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3908# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3909 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
3910 ! both emissions the same name; amdflang then launches the wrong one and a
3911 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
3912 ! give two line numbers. Do not merge them back into one.
3913# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3914
3915# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3916
3917# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3918#if defined(MFC_OpenACC)
3919# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3920!$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, &
3921# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3922!$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, &
3923# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3924!$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, &
3925# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3926!$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, &
3927# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3928!$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, &
3929# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3930!$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, &
3931# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3932!$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, &
3933# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3934!$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)
3935# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3936#elif defined(MFC_OpenMP)
3937# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3938
3939# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3940
3941# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3942
3943# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3944!$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, &
3945# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3946!$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, &
3947# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3948!$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, &
3949# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3950!$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, &
3951# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3952!$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, &
3953# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3954!$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, &
3955# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3956!$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, &
3957# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3958!$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, &
3959# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3960!$omp& sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
3961# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3962#endif
3963# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3964# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3965 do l = is3%beg, is3%end
3966 do k = is1%beg, is1%end
3967 do j = is2%beg, is2%end
3968 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3969 rho_l = 0._wp; rho_r = 0._wp
3970 gamma_l = 0._wp; gamma_r = 0._wp
3971 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3972 qv_l = 0._wp; qv_r = 0._wp
3973 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
3974
3975
3976# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3977#if defined(MFC_OpenACC)
3978# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3979!$acc loop seq
3980# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3981#elif defined(MFC_OpenMP)
3982# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3983
3984# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3985#endif
3986 do i = 1, num_fluids
3987 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3988 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3989 end do
3990
3991
3992# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3993#if defined(MFC_OpenACC)
3994# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3995!$acc loop seq
3996# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3997#elif defined(MFC_OpenMP)
3998# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3999
4000# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4001#endif
4002 do i = 1, num_dims
4003 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4004 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4005 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4006 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4007 end do
4008
4009 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4010 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4011
4012# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4013
4014# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4015#if defined(MFC_OpenACC)
4016# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4017!$acc loop seq
4018# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4019#elif defined(MFC_OpenMP)
4020# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4021
4022# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4023#endif
4024 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4025 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4026 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4027 end do
4028
4029 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
4030 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
4031 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
4032 if (n > 0) then
4033 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
4034 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
4035 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
4036 end if
4037 if (p > 0) then
4038 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
4039 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
4040 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
4041 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
4042 end if
4043 pres_tot_l = pres_l - tau_nn_l
4044 pres_tot_r = pres_r - tau_nn_r
4045 if (cyl_coord) then
4046 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4047 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4048 else
4049 tau_qq_l = 0._wp
4050 tau_qq_r = 0._wp
4051 end if
4052# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4053
4054 ! Change this by splitting it into the cases present in the bubbles_euler
4055 if (mpp_lim) then
4056
4057# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4058#if defined(MFC_OpenACC)
4059# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4060!$acc loop seq
4061# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4062#elif defined(MFC_OpenMP)
4063# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4064
4065# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4066#endif
4067 do i = 1, num_fluids
4068 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
4069 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
4070 & eqn_idx%E + i)), 1._wp)
4071 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
4072 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
4073 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
4074 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4075 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4076 end do
4077
4078
4079# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4080#if defined(MFC_OpenACC)
4081# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4082!$acc loop seq
4083# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4084#elif defined(MFC_OpenMP)
4085# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4086
4087# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4088#endif
4089 do i = 1, num_fluids
4090 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
4091 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
4092 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
4093 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
4094 end do
4095 end if
4096
4097 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
4098 ! downstream
4099
4100# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4101#if defined(MFC_OpenACC)
4102# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4103!$acc loop seq
4104# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4105#elif defined(MFC_OpenMP)
4106# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4107
4108# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4109#endif
4110 do i = 1, num_fluids
4111 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4112 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4113 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4114 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4115 end do
4116
4117 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
4118 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
4119
4120 if (viscous) then
4121 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
4122 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
4123 end if
4124
4125 if (chemistry) then
4126 c_sum_yi_phi = 0.0_wp
4127
4128# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4129#if defined(MFC_OpenACC)
4130# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4131!$acc loop seq
4132# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4133#elif defined(MFC_OpenMP)
4134# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4135
4136# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4137#endif
4138 do i = eqn_idx%species%beg, eqn_idx%species%end
4139 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
4140 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
4141 end do
4142
4143 call get_mixture_molecular_weight(ys_l, mw_l)
4144 call get_mixture_molecular_weight(ys_r, mw_r)
4145
4146 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
4147 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
4148
4149 r_gas_l = gas_constant/mw_l
4150 r_gas_r = gas_constant/mw_r
4151
4152 t_l = pres_l/rho_l/r_gas_l
4153 t_r = pres_r/rho_r/r_gas_r
4154
4155 call get_species_specific_heats_r(t_l, cp_il)
4156 call get_species_specific_heats_r(t_r, cp_ir)
4157
4158 if (chem_params%gamma_method == 1) then
4159 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4160 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
4161 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
4162
4163 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
4164 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
4165 else if (chem_params%gamma_method == 2) then
4166 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4167 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4168 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4169 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4170 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4171
4172 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
4173 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4174 end if
4175
4176 call get_mixture_energy_mass(t_l, ys_l, e_l)
4177 call get_mixture_energy_mass(t_r, ys_r, e_r)
4178
4179 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4180 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4181 h_l = (e_l + pres_l)/rho_l
4182 h_r = (e_r + pres_r)/rho_r
4183 else
4184 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
4185 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
4186
4187 h_l = (e_l + pres_l)/rho_l
4188 h_r = (e_r + pres_r)/rho_r
4189 end if
4190
4191# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4192 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
4193
4194# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4195#if defined(MFC_OpenACC)
4196# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4197!$acc loop seq
4198# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4199#elif defined(MFC_OpenMP)
4200# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4201
4202# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4203#endif
4204 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4205 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4206 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4207 end do
4208 damage_l = 0._wp; damage_r = 0._wp
4209 if (cont_damage) then
4210 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
4211 damage_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%damage)
4212 end if
4213
4214 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
4215 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
4216 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
4217 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
4218 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
4219 ! keep their pre-adjustment values here.
4220# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4221
4222 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
4223 ! average costs eight square roots per face.
4224 if (wave_speeds == wave_speeds_pressure) then
4225 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
4226 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
4227 if (chemistry .and. avg_state == avg_state_roe) then
4228 r_species(1:num_species) = gas_constant/molecular_weights
4229 call get_species_enthalpies_rt(t_l, h_il)
4230 call get_species_enthalpies_rt(t_r, h_ir)
4231 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
4232 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
4233 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
4234 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
4235 & gamma_avg, c_sum_yi_phi)
4236 end if
4237 end if
4238
4239 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
4240
4241 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
4242
4243 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
4244 ! costs eight square roots per face under the Roe average.
4245 if (wave_speeds == wave_speeds_pressure) then
4246 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
4247 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
4248 & alpha_rho_r)
4249 end if
4250
4251 if (viscous) then
4252 if (chemistry) then
4253 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
4254 end if
4255
4256# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4257#if defined(MFC_OpenACC)
4258# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4259!$acc loop seq
4260# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4261#elif defined(MFC_OpenMP)
4262# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4263
4264# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4265#endif
4266 do i = 1, 2
4267 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
4268 end do
4269 end if
4270
4271 ! Low Mach correction
4272 if (low_mach == 2) then
4273 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
4274 & vel_r(dir_idx(1)))
4275 end if
4276
4277 if (wave_speeds == wave_speeds_direct) then
4278# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4279 ! Elastic wave speed, Rodriguez et al. JCP (2019)
4280 s_l = min(vel_l(dir_idx(1)) - f_elastic_signal_speed(c_l, g_l, &
4281 & tau_e_l(dir_idx_tau(1)), rho_l), &
4282 & vel_r(dir_idx(1)) - f_elastic_signal_speed(c_r, g_r, &
4283 & tau_e_r(dir_idx_tau(1)), rho_r))
4284 s_r = max(vel_r(dir_idx(1)) + f_elastic_signal_speed(c_r, g_r, &
4285 & tau_e_r(dir_idx_tau(1)), rho_r), &
4286 & vel_l(dir_idx(1)) + f_elastic_signal_speed(c_l, g_l, &
4287 & tau_e_l(dir_idx_tau(1)), rho_l))
4288 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
4289 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
4290 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
4291 & - vel_r(dir_idx(1))))
4292# 1150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4293 else if (wave_speeds == wave_speeds_pressure) then
4294 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4295
4296 pres_sr = pres_sl
4297
4298 ! Low Mach correction: Thornber et al. JCP (2008)
4299 ms_l = max(1._wp, &
4300 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
4301 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
4302 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
4303 ms_r = max(1._wp, &
4304 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
4305 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
4306 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
4307
4308 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4309 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4310
4311 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4312 end if
4313
4314 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4315 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4316
4317 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4318 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4319 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4320 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
4321 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4322 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4323
4324 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4325 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4326 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4327
4328 ! Low Mach correction
4329 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
4330 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
4331
4332# 1190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4333 if (n == 0) then
4334 u_t_l = 0._wp; u_t_r = 0._wp
4335 tau_nt_l = 0._wp; tau_nt_r = 0._wp
4336 end if
4337 if (p == 0) then
4338 u_t2_l = 0._wp; u_t2_r = 0._wp
4339 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
4340 end if
4341 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
4342 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
4343 denom_a = a_r - a_l
4344 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
4345 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
4346 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
4347 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
4348 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
4349# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4350
4351 ! COMPUTING THE HLLC FLUXES MASS FLUX.
4352
4353# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4354#if defined(MFC_OpenACC)
4355# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4356!$acc loop seq
4357# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4358#elif defined(MFC_OpenMP)
4359# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4360
4361# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4362#endif
4363 do i = 1, eqn_idx%cont%end
4364 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4365 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4366 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4367 end do
4368
4369# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4370 flux_rsx_vf(j, k, l, &
4371 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
4372 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
4373 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
4374 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
4375 if (n > 0) then
4376 flux_rsx_vf(j, k, l, &
4377 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
4378 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
4379 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
4380 & - tau_nt_r)
4381 end if
4382 if (p > 0) then
4383 flux_rsx_vf(j, k, l, &
4384 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
4385 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
4386 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
4387 & - tau_nt2_r)
4388 end if
4389
4390 flux_rsx_vf(j, k, l, &
4391 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
4392 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
4393 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
4394 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
4395 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
4396 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
4397 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
4398 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
4399 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
4400 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
4401
4402 if (n == 0) then
4403 flux_rsx_vf(j, k, l, &
4404 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
4405 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
4406 & + s_p*(xi_r - 1._wp))
4407 else if (p == 0) then
4408 if (dir_idx(1) == 1) then
4409 flux_rsx_vf(j, k, l, &
4410 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
4411 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
4412 & + s_p*(xi_r - 1._wp))
4413 flux_rsx_vf(j, k, l, &
4414 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
4415 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
4416 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
4417 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
4418 flux_rsx_vf(j, k, l, &
4419 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
4420 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
4421 & + s_p*(xi_r - 1._wp))
4422 else
4423 flux_rsx_vf(j, k, l, &
4424 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
4425 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
4426 & + s_p*(xi_r - 1._wp))
4427 flux_rsx_vf(j, k, l, &
4428 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
4429 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
4430 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
4431 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
4432 flux_rsx_vf(j, k, l, &
4433 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
4434 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
4435 & + s_p*(xi_r - 1._wp))
4436 end if
4437 else
4438 flux_rsx_vf(j, k, l, &
4439 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
4440 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4441 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4442 flux_rsx_vf(j, k, l, &
4443 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
4444 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
4445 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
4446 & - rho_r*tau_nt_r))
4447 flux_rsx_vf(j, k, l, &
4448 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
4449 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
4450 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
4451 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
4452 flux_rsx_vf(j, k, l, &
4453 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
4454 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4455 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4456 flux_rsx_vf(j, k, l, &
4457 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
4458 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4459 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4460 flux_rsx_vf(j, k, l, &
4461 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
4462 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
4463 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
4464 end if
4465 if (cyl_coord) then
4466 flux_rsx_vf(j, k, l, &
4467 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
4468 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
4469 & + s_p*(xi_r - 1._wp))
4470 end if
4471
4472 ! Damage flux: U_D = m_s*D (damageable-solid partial mass)
4473 if (cont_damage) then
4474 solid_partial_density_l = 0._wp; solid_partial_density_r = 0._wp
4475
4476# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4477#if defined(MFC_OpenACC)
4478# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4479!$acc loop seq
4480# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4481#elif defined(MFC_OpenMP)
4482# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4483
4484# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4485#endif
4486 do i = 1, num_fluids
4487 if (gs_rs(i) > verysmall) then
4488 solid_partial_density_l = solid_partial_density_l + alpha_rho_l(i)
4489 solid_partial_density_r = solid_partial_density_r + alpha_rho_r(i)
4490 end if
4491 end do
4492 flux_rsx_vf(j, k, l, &
4493 & eqn_idx%damage) &
4494 & = xi_m*solid_partial_density_l*damage_l*(vel_l(dir_idx(1)) + s_m*(xi_l &
4495 & - 1._wp)) + xi_p*solid_partial_density_r*damage_r*(vel_r(dir_idx(1)) &
4496 & + s_p*(xi_r - 1._wp))
4497 end if
4498
4499 if (s_l >= 0._wp) then
4500 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
4501 else if (s_r <= 0._wp) then
4502 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
4503 else
4504 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
4505 end if
4506 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
4507 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
4508 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
4509# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4510
4511 ! VOLUME FRACTION FLUX.
4512
4513# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4514#if defined(MFC_OpenACC)
4515# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4516!$acc loop seq
4517# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4518#elif defined(MFC_OpenMP)
4519# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4520
4521# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4522#endif
4523 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4524 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4525 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4526 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4527 end do
4528
4529 ! VOLUME FRACTION SOURCE FLUX.
4530
4531# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4532#if defined(MFC_OpenACC)
4533# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4534!$acc loop seq
4535# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4536#elif defined(MFC_OpenMP)
4537# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4538
4539# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4540#endif
4541 do i = 1, num_dims
4542 vel_src_rsx_vf(j, k, l, &
4543 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
4544 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
4545 end do
4546
4547 ! COLOR FUNCTION FLUX
4548 if (surface_tension) then
4549 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
4550 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4551 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4552 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4553 end if
4554
4555 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4556
4557 if (chemistry) then
4558
4559# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4560#if defined(MFC_OpenACC)
4561# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4562!$acc loop seq
4563# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4564#elif defined(MFC_OpenMP)
4565# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4566
4567# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4568#endif
4569 do i = eqn_idx%species%beg, eqn_idx%species%end
4570 y_l = ql_prim_rsx_vf(j, k, l, i)
4571 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
4572
4573 flux_rsx_vf(j, k, l, &
4574 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4575 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4576 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
4577 end do
4578 end if
4579
4580# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4581 ! HLLC-ADC blending for hypoelasticity
4582 if (riemann_hypo_adc) then
4583 ! Build U_L, U_R and F_L, F_R in local-basis layout
4584
4585# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4586#if defined(MFC_OpenACC)
4587# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4588!$acc loop seq
4589# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4590#elif defined(MFC_OpenMP)
4591# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4592
4593# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4594#endif
4595 do i = 1, num_fluids
4596 u_l(i) = alpha_rho_l(i)
4597 u_r(i) = alpha_rho_r(i)
4598 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
4599 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
4600 f_l(i) = alpha_rho_l(i)*u_n_l
4601 f_r(i) = alpha_rho_r(i)*u_n_r
4602 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
4603 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
4604 end do
4605
4606 ! Momentum U/F in physical order via dir_idx
4607 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
4608 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
4609 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
4610 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
4611 if (n > 0) then
4612 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
4613 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
4614 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
4615 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
4616 end if
4617 if (p > 0) then
4618 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
4619 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
4620 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
4621 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
4622 end if
4623
4624 u_l(eqn_idx%E) = e_l
4625 u_r(eqn_idx%E) = e_r
4626 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
4627 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
4628
4629 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
4630
4631# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4632#if defined(MFC_OpenACC)
4633# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4634!$acc loop seq
4635# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4636#elif defined(MFC_OpenMP)
4637# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4638
4639# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4640#endif
4641 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
4642 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
4643 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
4644 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
4645 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
4646 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
4647 end do
4648 if (cyl_coord) then
4649 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
4650 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
4651 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
4652 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
4653 end if
4654
4655 ! Compute F_HLL (physical order) and HLL trace velocities
4656 if (s_l >= 0._wp) then
4657
4658# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4659#if defined(MFC_OpenACC)
4660# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4661!$acc loop seq
4662# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4663#elif defined(MFC_OpenMP)
4664# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4665
4666# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4667#endif
4668 do i = 1, sys_size
4669 f_hll(i) = f_l(i)
4670 end do
4671 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
4672 else if (s_r <= 0._wp) then
4673
4674# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4675#if defined(MFC_OpenACC)
4676# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4677!$acc loop seq
4678# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4679#elif defined(MFC_OpenMP)
4680# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4681
4682# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4683#endif
4684 do i = 1, sys_size
4685 f_hll(i) = f_r(i)
4686 end do
4687 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
4688 else
4689
4690# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4691#if defined(MFC_OpenACC)
4692# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4693!$acc loop seq
4694# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4695#elif defined(MFC_OpenMP)
4696# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4697
4698# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4699#endif
4700 do i = 1, sys_size
4701 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 &
4702 & + verysmall)
4703 end do
4704 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
4705 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
4706 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
4707 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
4708 end if
4709
4710 ! ADC sensor
4711 sigma_l = pres_tot_l
4712 sigma_r = pres_tot_r
4713 dsigma = sigma_r - sigma_l
4714 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
4715
4716 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
4717 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
4718 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
4719
4720 du_t = u_t_r - u_t_l
4721 dtau_nt = tau_nt_r - tau_nt_l
4722 du_t2 = u_t2_r - u_t2_l
4723 dtau_nt2 = tau_nt2_r - tau_nt2_l
4724
4725 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
4726 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
4727 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
4728 & + verysmall)
4729
4730 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
4731 phi = exp(-(sensor_combined**adc_power))
4732
4733 ! Blend all flux components: F_HLL is in physical order
4734
4735# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4736#if defined(MFC_OpenACC)
4737# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4738!$acc loop seq
4739# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4740#elif defined(MFC_OpenMP)
4741# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4742
4743# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4744#endif
4745 do i = 1, sys_size
4746 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
4747 end do
4748
4749 ! Blend interface velocities (scalar HLL traces)
4750 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
4751 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
4752 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
4753
4754 ! Overwrite vel_src with blended velocities
4755 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
4756 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
4757 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
4758
4759 ! Update advection source flux with ADC-blended face-normal velocity
4760 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
4761
4762 ! Overwrite nc_iface_vel with blended velocities
4763 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
4764 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
4765 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
4766 end if
4767 ! END HLLC-ADC
4768# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4769
4770 ! Geometrical source flux for cylindrical coordinates
4771# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4772# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4773 if (cyl_coord) then
4774
4775# 1544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4776#if defined(MFC_OpenACC)
4777# 1544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4778!$acc loop seq
4779# 1544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4780#elif defined(MFC_OpenMP)
4781# 1544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4782
4783# 1544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4784#endif
4785 do i = 1, sys_size
4786 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4787 end do
4788 if (s_l >= 0._wp) then
4789 p_face = pres_l; tau_qq_face = tau_qq_l
4790 else if (s_r <= 0._wp) then
4791 p_face = pres_r; tau_qq_face = tau_qq_r
4792 else if (s_s >= 0._wp) then
4793 p_face = pres_tot_star + tau_nn_l; tau_qq_face = tau_qq_l
4794 else
4795 p_face = pres_tot_star + tau_nn_r; tau_qq_face = tau_qq_r
4796 end if
4797 flux_gsrc_rsx_vf(j, k, l, &
4798 & eqn_idx%cont%end + dir_idx(1)) = flux_rsx_vf(j, k, l, &
4799 & eqn_idx%cont%end + dir_idx(1)) - p_face + tau_qq_face
4800
4801# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4802#if defined(MFC_OpenACC)
4803# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4804!$acc loop seq
4805# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4806#elif defined(MFC_OpenMP)
4807# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4808
4809# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4810#endif
4811 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4812 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4813 end do
4814 end if
4815# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4816# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4817# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4818 end do
4819 end do
4820 end do
4821
4822# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4823#if defined(MFC_OpenACC)
4824# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4825!$acc end parallel loop
4826# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4827#elif defined(MFC_OpenMP)
4828# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4829
4830# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4831!$omp end target teams loop
4832# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4833#endif
4834# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4835# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4836 else
4837# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4838 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
4839 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
4840 ! statement and private variable from the pure-fluid emission, keeping its body and directive
4841 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
4842 ! pinned it at the GPU register ceiling for every HLLC user.
4843 ! One source of truth for this kernel's private variables: both emissions of the shared body take
4844 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
4845 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
4846 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
4847# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4848# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4849# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4850# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4851# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4852# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4853# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4854# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4855# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4856# 880 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4857# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4858# 884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4859# 889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4860# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4861# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4862 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
4863 ! both emissions the same name; amdflang then launches the wrong one and a
4864 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
4865 ! give two line numbers. Do not merge them back into one.
4866# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4867
4868# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4869
4870# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4871#if defined(MFC_OpenACC)
4872# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4873!$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, &
4874# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4875!$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, &
4876# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4877!$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, &
4878# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4879!$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)
4880# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4881#elif defined(MFC_OpenMP)
4882# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4883
4884# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4885
4886# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4887
4888# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4889!$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, &
4890# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4891!$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, &
4892# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4893!$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, &
4894# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4895!$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, &
4896# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4897!$omp& Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
4898# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4899#endif
4900# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4901# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4902 do l = is3%beg, is3%end
4903 do k = is1%beg, is1%end
4904 do j = is2%beg, is2%end
4905 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4906 rho_l = 0._wp; rho_r = 0._wp
4907 gamma_l = 0._wp; gamma_r = 0._wp
4908 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4909 qv_l = 0._wp; qv_r = 0._wp
4910 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
4911
4912
4913# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4914#if defined(MFC_OpenACC)
4915# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4916!$acc loop seq
4917# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4918#elif defined(MFC_OpenMP)
4919# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4920
4921# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4922#endif
4923 do i = 1, num_fluids
4924 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4925 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4926 end do
4927
4928
4929# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4930#if defined(MFC_OpenACC)
4931# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4932!$acc loop seq
4933# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4934#elif defined(MFC_OpenMP)
4935# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4936
4937# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4938#endif
4939 do i = 1, num_dims
4940 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4941 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4942 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4943 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4944 end do
4945
4946 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4947 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4948
4949# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4950
4951 ! Change this by splitting it into the cases present in the bubbles_euler
4952 if (mpp_lim) then
4953
4954# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4955#if defined(MFC_OpenACC)
4956# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4957!$acc loop seq
4958# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4959#elif defined(MFC_OpenMP)
4960# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4961
4962# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4963#endif
4964 do i = 1, num_fluids
4965 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
4966 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
4967 & eqn_idx%E + i)), 1._wp)
4968 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
4969 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
4970 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
4971 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4972 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4973 end do
4974
4975
4976# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4977#if defined(MFC_OpenACC)
4978# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4979!$acc loop seq
4980# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4981#elif defined(MFC_OpenMP)
4982# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4983
4984# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4985#endif
4986 do i = 1, num_fluids
4987 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
4988 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
4989 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
4990 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
4991 end do
4992 end if
4993
4994 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
4995 ! downstream
4996
4997# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4998#if defined(MFC_OpenACC)
4999# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5000!$acc loop seq
5001# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5002#elif defined(MFC_OpenMP)
5003# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5004
5005# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5006#endif
5007 do i = 1, num_fluids
5008 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5009 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
5010 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5011 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5012 end do
5013
5014 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
5015 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
5016
5017 if (viscous) then
5018 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
5019 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
5020 end if
5021
5022 if (chemistry) then
5023 c_sum_yi_phi = 0.0_wp
5024
5025# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5026#if defined(MFC_OpenACC)
5027# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5028!$acc loop seq
5029# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5030#elif defined(MFC_OpenMP)
5031# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5032
5033# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5034#endif
5035 do i = eqn_idx%species%beg, eqn_idx%species%end
5036 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5037 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
5038 end do
5039
5040 call get_mixture_molecular_weight(ys_l, mw_l)
5041 call get_mixture_molecular_weight(ys_r, mw_r)
5042
5043 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
5044 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
5045
5046 r_gas_l = gas_constant/mw_l
5047 r_gas_r = gas_constant/mw_r
5048
5049 t_l = pres_l/rho_l/r_gas_l
5050 t_r = pres_r/rho_r/r_gas_r
5051
5052 call get_species_specific_heats_r(t_l, cp_il)
5053 call get_species_specific_heats_r(t_r, cp_ir)
5054
5055 if (chem_params%gamma_method == 1) then
5056 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5057 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
5058 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
5059
5060 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
5061 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
5062 else if (chem_params%gamma_method == 2) then
5063 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5064 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5065 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5066 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5067 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5068
5069 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
5070 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5071 end if
5072
5073 call get_mixture_energy_mass(t_l, ys_l, e_l)
5074 call get_mixture_energy_mass(t_r, ys_r, e_r)
5075
5076 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5077 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5078 h_l = (e_l + pres_l)/rho_l
5079 h_r = (e_r + pres_r)/rho_r
5080 else
5081 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
5082 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
5083
5084 h_l = (e_l + pres_l)/rho_l
5085 h_r = (e_r + pres_r)/rho_r
5086 end if
5087
5088# 1079 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5089 h_l = (e_l + pres_l)/rho_l
5090 h_r = (e_r + pres_r)/rho_r
5091# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5092
5093 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
5094 ! average costs eight square roots per face.
5095 if (wave_speeds == wave_speeds_pressure) then
5096 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
5097 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
5098 if (chemistry .and. avg_state == avg_state_roe) then
5099 r_species(1:num_species) = gas_constant/molecular_weights
5100 call get_species_enthalpies_rt(t_l, h_il)
5101 call get_species_enthalpies_rt(t_r, h_ir)
5102 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
5103 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
5104 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
5105 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
5106 & gamma_avg, c_sum_yi_phi)
5107 end if
5108 end if
5109
5110 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
5111
5112 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
5113
5114 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
5115 ! costs eight square roots per face under the Roe average.
5116 if (wave_speeds == wave_speeds_pressure) then
5117 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
5118 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
5119 & alpha_rho_r)
5120 end if
5121
5122 if (viscous) then
5123 if (chemistry) then
5124 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
5125 end if
5126
5127# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5128#if defined(MFC_OpenACC)
5129# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5130!$acc loop seq
5131# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5132#elif defined(MFC_OpenMP)
5133# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5134
5135# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5136#endif
5137 do i = 1, 2
5138 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5139 end do
5140 end if
5141
5142 ! Low Mach correction
5143 if (low_mach == 2) then
5144 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
5145 & vel_r(dir_idx(1)))
5146 end if
5147
5148 if (wave_speeds == wave_speeds_direct) then
5149# 1144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5150 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5151 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5152 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5153 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
5154 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
5155# 1150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5156 else if (wave_speeds == wave_speeds_pressure) then
5157 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5158
5159 pres_sr = pres_sl
5160
5161 ! Low Mach correction: Thornber et al. JCP (2008)
5162 ms_l = max(1._wp, &
5163 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
5164 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
5165 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
5166 ms_r = max(1._wp, &
5167 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
5168 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
5169 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
5170
5171 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5172 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5173
5174 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5175 end if
5176
5177 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5178 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5179
5180 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5181 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5182 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5183 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
5184 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5185 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5186
5187 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5188 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5189 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5190
5191 ! Low Mach correction
5192 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
5193 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
5194
5195# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5196
5197 ! COMPUTING THE HLLC FLUXES MASS FLUX.
5198
5199# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5200#if defined(MFC_OpenACC)
5201# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5202!$acc loop seq
5203# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5204#elif defined(MFC_OpenMP)
5205# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5206
5207# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5208#endif
5209 do i = 1, eqn_idx%cont%end
5210 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5211 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5212 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5213 end do
5214
5215# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5216
5217# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5218#if defined(MFC_OpenACC)
5219# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5220!$acc loop seq
5221# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5222#elif defined(MFC_OpenMP)
5223# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5224
5225# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5226#endif
5227 do i = 1, num_dims
5228 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
5229 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
5230 flux_rsx_vf(j, k, l, &
5231 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
5232 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
5233 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
5234 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5235 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
5236 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
5237 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
5238 end do
5239
5240 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
5241 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
5242 flux_rsx_vf(j, k, l, &
5243 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
5244 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
5245 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
5246 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
5247 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
5248# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5249
5250 ! VOLUME FRACTION FLUX.
5251
5252# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5253#if defined(MFC_OpenACC)
5254# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5255!$acc loop seq
5256# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5257#elif defined(MFC_OpenMP)
5258# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5259
5260# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5261#endif
5262 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5263 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5264 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5265 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5266 end do
5267
5268 ! VOLUME FRACTION SOURCE FLUX.
5269
5270# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5271#if defined(MFC_OpenACC)
5272# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5273!$acc loop seq
5274# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5275#elif defined(MFC_OpenMP)
5276# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5277
5278# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5279#endif
5280 do i = 1, num_dims
5281 vel_src_rsx_vf(j, k, l, &
5282 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
5283 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
5284 end do
5285
5286 ! COLOR FUNCTION FLUX
5287 if (surface_tension) then
5288 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
5289 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5290 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5291 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5292 end if
5293
5294 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5295
5296 if (chemistry) then
5297
5298# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5299#if defined(MFC_OpenACC)
5300# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5301!$acc loop seq
5302# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5303#elif defined(MFC_OpenMP)
5304# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5305
5306# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5307#endif
5308 do i = eqn_idx%species%beg, eqn_idx%species%end
5309 y_l = ql_prim_rsx_vf(j, k, l, i)
5310 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5311
5312 flux_rsx_vf(j, k, l, &
5313 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5314 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5315 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
5316 end do
5317 end if
5318
5319# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5320
5321 ! Geometrical source flux for cylindrical coordinates
5322# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5323# 1566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5324 if (cyl_coord) then
5325 ! Substituting the advective flux into the inviscid geometrical source flux
5326
5327# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5328#if defined(MFC_OpenACC)
5329# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5330!$acc loop seq
5331# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5332#elif defined(MFC_OpenMP)
5333# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5334
5335# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5336#endif
5337 do i = 1, eqn_idx%E
5338 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5339 end do
5340 ! Recalculating the radial momentum geometric source flux
5341 flux_gsrc_rsx_vf(j, k, l, &
5342 & eqn_idx%cont%end + dir_idx(1)) &
5343 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, &
5344 & vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
5345 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
5346 ! Geometrical source of the void fraction(s) is zero
5347
5348# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5349#if defined(MFC_OpenACC)
5350# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5351!$acc loop seq
5352# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5353#elif defined(MFC_OpenMP)
5354# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5355
5356# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5357#endif
5358 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5359 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5360 end do
5361 end if
5362# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5363# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5364# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5365 end do
5366 end do
5367 end do
5368
5369# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5370#if defined(MFC_OpenACC)
5371# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5372!$acc end parallel loop
5373# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5374#elif defined(MFC_OpenMP)
5375# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5376
5377# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5378!$omp end target teams loop
5379# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5380#endif
5381# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5382 end if
5383 end if
5384# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5385# 176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5386# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5387 if (norm_dir == 3) then
5388 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
5389 if (model_eqns == model_eqns_6eq) then
5390 ! 6-equation model (model_eqns=3): separate phasic internal energies
5391
5392# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5393
5394# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5395#if defined(MFC_OpenACC)
5396# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5397!$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, &
5398# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5399!$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, &
5400# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5401!$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, &
5402# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5403!$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, &
5404# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5405!$acc& p_isen_L, p_isen_R, e_K_star) firstprivate(Re_size_loc1, Re_size_loc2)
5406# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5407#elif defined(MFC_OpenMP)
5408# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5409
5410# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5411
5412# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5413
5414# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5415!$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, &
5416# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5417!$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, &
5418# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5419!$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, &
5420# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5421!$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, &
5422# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5423!$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)
5424# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5425#endif
5426# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5427 do l = is1%beg, is1%end
5428 do k = is2%beg, is2%end
5429 do j = is3%beg, is3%end
5430 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5431 rho_l = 0._wp; rho_r = 0._wp
5432 gamma_l = 0._wp; gamma_r = 0._wp
5433 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5434 qv_l = 0._wp; qv_r = 0._wp
5435 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
5436
5437
5438# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5439#if defined(MFC_OpenACC)
5440# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5441!$acc loop seq
5442# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5443#elif defined(MFC_OpenMP)
5444# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5445
5446# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5447#endif
5448 do i = 1, num_dims
5449 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5450 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
5451 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5452 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5453 end do
5454
5455 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5456 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
5457
5458 rho_l = 0._wp
5459 gamma_l = 0._wp
5460 pi_inf_l = 0._wp
5461 qv_l = 0._wp
5462
5463 rho_r = 0._wp
5464 gamma_r = 0._wp
5465 pi_inf_r = 0._wp
5466 qv_r = 0._wp
5467
5468 alpha_l_sum = 0._wp
5469 alpha_r_sum = 0._wp
5470
5471 if (mpp_lim) then
5472
5473# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5474#if defined(MFC_OpenACC)
5475# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5476!$acc loop seq
5477# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5478#elif defined(MFC_OpenMP)
5479# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5480
5481# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5482#endif
5483 do i = 1, num_fluids
5484 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5485 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5486 & eqn_idx%E + i)), 1._wp)
5487 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5488 end do
5489
5490
5491# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5492#if defined(MFC_OpenACC)
5493# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5494!$acc loop seq
5495# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5496#elif defined(MFC_OpenMP)
5497# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5498
5499# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5500#endif
5501 do i = 1, num_fluids
5502 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
5503 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
5504 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
5505 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
5506 end do
5507
5508
5509# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5510#if defined(MFC_OpenACC)
5511# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5512!$acc loop seq
5513# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5514#elif defined(MFC_OpenMP)
5515# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5516
5517# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5518#endif
5519 do i = 1, num_fluids
5520 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5521 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5522 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
5523 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5524 end do
5525 end if
5526
5527
5528# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5529#if defined(MFC_OpenACC)
5530# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5531!$acc loop seq
5532# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5533#elif defined(MFC_OpenMP)
5534# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5535
5536# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5537#endif
5538 do i = 1, num_fluids
5539 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5540 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
5541 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
5542 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
5543 end do
5544
5545 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
5546 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
5547
5548 if (viscous) then
5549 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
5550 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
5551 end if
5552
5553 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
5554 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
5555
5556 h_l = (e_l + pres_l)/rho_l
5557 h_r = (e_r + pres_r)/rho_r
5558
5559 ! Only the Roe path writes this, and chemistry is unreachable at model_eqns = 6eq; zero it
5560 ! so the sound speed below never reads an undefined value.
5561 c_sum_yi_phi = 0._wp
5562
5563 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
5564 ! average costs eight square roots per face.
5565 if (wave_speeds == wave_speeds_pressure) then
5566 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, qv_l, &
5567 & qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
5568 end if
5569
5570 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
5571
5572 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
5573
5574 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
5575 ! costs eight square roots per face under the Roe average.
5576 if (wave_speeds == wave_speeds_pressure) then
5577 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
5578 & h_avg, c_sum_yi_phi, alpha_r, c_avg, alpha_rho_r)
5579 end if
5580
5581 if (viscous) then
5582
5583# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5584#if defined(MFC_OpenACC)
5585# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5586!$acc loop seq
5587# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5588#elif defined(MFC_OpenMP)
5589# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5590
5591# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5592#endif
5593 do i = 1, 2
5594 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5595 end do
5596 end if
5597
5598 ! Low Mach correction
5599 if (low_mach == 2) then
5600 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
5601 & vel_r(dir_idx(1)))
5602 end if
5603
5604 ! COMPUTING THE DIRECT WAVE SPEEDS
5605 if (wave_speeds == wave_speeds_direct) then
5606 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5607 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5608 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5609 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
5610 & - rho_r*(s_r - vel_r(dir_idx(1))))
5611 else if (wave_speeds == wave_speeds_pressure) then
5612 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5613
5614 pres_sr = pres_sl
5615
5616 ! Low Mach correction: Thornber et al. JCP (2008)
5617 ms_l = max(1._wp, &
5618 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
5619 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
5620 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
5621 ms_r = max(1._wp, &
5622 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
5623 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
5624 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
5625
5626 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5627 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5628
5629 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5630 end if
5631
5632 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5633 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5634
5635 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5636 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5637 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5638 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5639 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5640
5641 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5642 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
5643 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
5644
5645 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
5646 xi_mp = -min(0._wp, sign(1._wp, s_l))
5647 xi_pp = max(0._wp, sign(1._wp, s_r))
5648
5649 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 &
5650 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
5651 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
5652 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
5653 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
5654
5655 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))
5656
5657 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 &
5658 & - vel_r(dir_idx(1)))
5659
5660 ! Low Mach correction
5661 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
5662 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
5663
5664 ! COMPUTING FLUXES MASS FLUX.
5665
5666# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5667#if defined(MFC_OpenACC)
5668# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5669!$acc loop seq
5670# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5671#elif defined(MFC_OpenMP)
5672# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5673
5674# 369 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5675#endif
5676 do i = 1, eqn_idx%cont%end
5677 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5678 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
5679 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5680 end do
5681
5682 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
5683
5684# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5685#if defined(MFC_OpenACC)
5686# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5687!$acc loop seq
5688# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5689#elif defined(MFC_OpenMP)
5690# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5691
5692# 377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5693#endif
5694 do i = 1, num_dims
5695 flux_rsx_vf(j, k, l, &
5696 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
5697 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
5698 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
5699 & *dir_flg(dir_idx(i))*pcorr
5700 end do
5701
5702 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
5703 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
5704
5705 ! VOLUME FRACTION FLUX.
5706
5707# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5708#if defined(MFC_OpenACC)
5709# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5710!$acc loop seq
5711# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5712#elif defined(MFC_OpenMP)
5713# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5714
5715# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5716#endif
5717 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5718 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5719 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
5720 end do
5721
5722 ! Advection velocity source: interface velocity for volume fraction transport
5723
5724# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5725#if defined(MFC_OpenACC)
5726# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5727!$acc loop seq
5728# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5729#elif defined(MFC_OpenMP)
5730# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5731
5732# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5733#endif
5734 do i = 1, num_dims
5735 vel_src_rsx_vf(j, k, l, &
5736 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5737 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
5738 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
5739 end do
5740
5741 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
5742 ! energy flux
5743
5744# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5745#if defined(MFC_OpenACC)
5746# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5747!$acc loop seq
5748# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5749#elif defined(MFC_OpenMP)
5750# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5751
5752# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5753#endif
5754 do i = 1, num_fluids
5755 ! Phasic isentrope p* from the upwind state: closed form for stiffened gas, integrated
5756 ! for a state-dependent EOS.
5757 call s_phase_pressure_on_isentrope(pres_l, alpha_rho_l(i)/max(alpha_l(i), sgm_eps), xi_l, i, &
5758 & p_isen_l)
5759 call s_phase_pressure_on_isentrope(pres_r, alpha_rho_r(i)/max(alpha_r(i), sgm_eps), xi_r, i, &
5760 & p_isen_r)
5761 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)
5762
5763 alpha_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
5764 & i + eqn_idx%adv%beg - 1) &
5765 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
5766 & i + eqn_idx%adv%beg - 1)
5767 alpha_rho_k_star = xi_m*ql_prim_rsx_vf(j, k, l, &
5768 & i + eqn_idx%cont%beg - 1) &
5769 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
5770 & i + eqn_idx%cont%beg - 1)
5771 ! Star partial density xi_K alpha_rho, blended like p_K_Star: a state-dependent EOS reads
5772 ! its coefficients at the star density, not the upwind one.
5773 call s_phase_internal_energy(p_k_star, alpha_k_star, &
5774 & alpha_rho_k_star*(1._wp + xi_m*xi_mp*(xi_l - 1._wp) &
5775 & + xi_p*xi_pp*(xi_r - 1._wp)), i, e_k_star)
5776 flux_rsx_vf(j, k, l, &
5777 & i + eqn_idx%int_en%beg - 1) = e_k_star*vel_k_star + (s_m/s_l)*(s_p/s_r) &
5778 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
5779 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
5780 & i + eqn_idx%adv%beg - 1))
5781 end do
5782
5783 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5784
5785 ! COLOR FUNCTION FLUX
5786 if (surface_tension) then
5787 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
5788 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
5789 end if
5790
5791 ! Geometrical source flux for cylindrical coordinates
5792# 468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5793# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5794 if (grid_geometry == 3) then
5795
5796# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5797#if defined(MFC_OpenACC)
5798# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5799!$acc loop seq
5800# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5801#elif defined(MFC_OpenMP)
5802# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5803
5804# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5805#endif
5806 do i = 1, sys_size
5807 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5808 end do
5809 flux_gsrc_rsx_vf(j, k, l, &
5810 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
5811 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
5812
5813 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
5814 end if
5815# 481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5816 end do
5817 end do
5818 end do
5819
5820# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5821#if defined(MFC_OpenACC)
5822# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5823!$acc end parallel loop
5824# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5825#elif defined(MFC_OpenMP)
5826# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5827
5828# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5829!$omp end target teams loop
5830# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5831#endif
5832 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
5833 ! 5-equation model with Euler-Euler bubble dynamics
5834
5835# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5836
5837# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5838#if defined(MFC_OpenACC)
5839# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5840!$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, &
5841# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5842!$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, &
5843# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5844!$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, &
5845# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5846!$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)
5847# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5848#elif defined(MFC_OpenMP)
5849# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5850
5851# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5852
5853# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5854
5855# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5856!$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, &
5857# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5858!$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, &
5859# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5860!$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, &
5861# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5862!$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) &
5863# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5864!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
5865# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5866#endif
5867# 495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5868 do l = is1%beg, is1%end
5869 do k = is2%beg, is2%end
5870 do j = is3%beg, is3%end
5871 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5872 rho_l = 0._wp; rho_r = 0._wp
5873 gamma_l = 0._wp; gamma_r = 0._wp
5874 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5875 qv_l = 0._wp; qv_r = 0._wp
5876
5877
5878# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5879#if defined(MFC_OpenACC)
5880# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5881!$acc loop seq
5882# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5883#elif defined(MFC_OpenMP)
5884# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5885
5886# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5887#endif
5888 do i = 1, num_fluids
5889 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5890 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
5891 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5892 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
5893 end do
5894
5895 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5896
5897
5898# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5899#if defined(MFC_OpenACC)
5900# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5901!$acc loop seq
5902# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5903#elif defined(MFC_OpenMP)
5904# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5905
5906# 514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5907#endif
5908 do i = 1, num_dims
5909 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5910 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
5911 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5912 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5913 end do
5914
5915 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, qv_l)
5916 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, qv_r)
5917
5918 if (viscous) then
5919 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
5920
5921# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5922#if defined(MFC_OpenACC)
5923# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5924!$acc loop seq
5925# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5926#elif defined(MFC_OpenMP)
5927# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5928
5929# 527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5930#endif
5931 do i = 1, 2
5932 re_l(i) = dflt_real
5933 re_r(i) = dflt_real
5934
5935 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
5936 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
5937
5938
5939# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5940#if defined(MFC_OpenACC)
5941# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5942!$acc loop seq
5943# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5944#elif defined(MFC_OpenMP)
5945# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5946
5947# 535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5948#endif
5949 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
5950 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
5951 & q)))/res_gs(i, q) + re_l(i)
5952 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
5953 & q)))/res_gs(i, q) + re_r(i)
5954 end do
5955
5956 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5957 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5958 end do
5959 end if
5960 end if
5961
5962 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5963 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
5964
5965 call s_compute_energy(pres_l, alpha_rho_l, alpha_l, vel_l_rms, e_l)
5966 call s_compute_energy(pres_r, alpha_rho_r, alpha_r, vel_r_rms, e_r)
5967
5968 h_l = (e_l + pres_l)/rho_l
5969 h_r = (e_r + pres_r)/rho_r
5970
5971 if (avg_state == avg_state_arithmetic) then
5972
5973# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5974#if defined(MFC_OpenACC)
5975# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5976!$acc loop seq
5977# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5978#elif defined(MFC_OpenMP)
5979# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5980
5981# 559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5982#endif
5983 do i = 1, nb
5984 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
5985 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
5986
5987 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
5988 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
5989 if (.not. polytropic .and. .not. qbmm) then
5990 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
5991 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
5992 end if
5993 end do
5994
5995 if (.not. qbmm) then
5996 if (adv_n) then
5997 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
5998 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
5999 else
6000 nbub_l = 0._wp
6001 nbub_r = 0._wp
6002
6003# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6004#if defined(MFC_OpenACC)
6005# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6006!$acc loop seq
6007# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6008#elif defined(MFC_OpenMP)
6009# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6010
6011# 579 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6012#endif
6013 do i = 1, nb
6014 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
6015 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
6016 end do
6017
6018 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
6019 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
6020 & eqn_idx%E + num_fluids)/nbub_r
6021 end if
6022 else
6023 ! nb stored in 0th moment of first R0 bin in variable conversion module
6024 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
6025 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
6026 end if
6027
6028
6029# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6030#if defined(MFC_OpenACC)
6031# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6032!$acc loop seq
6033# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6034#elif defined(MFC_OpenMP)
6035# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6036
6037# 595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6038#endif
6039 do i = 1, nb
6040 if (.not. qbmm) then
6041 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
6042 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
6043 end if
6044 end do
6045
6046 if (qbmm) then
6047 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
6048 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
6049
6050 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
6051 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
6052
6053 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
6054 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
6055 else
6056 pbwr3lbar = 0._wp
6057 pbwr3rbar = 0._wp
6058
6059 r3lbar = 0._wp
6060 r3rbar = 0._wp
6061
6062 r3v2lbar = 0._wp
6063 r3v2rbar = 0._wp
6064
6065
6066# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6067#if defined(MFC_OpenACC)
6068# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6069!$acc loop seq
6070# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6071#elif defined(MFC_OpenMP)
6072# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6073
6074# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6075#endif
6076 do i = 1, nb
6077 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
6078 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
6079
6080 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
6081 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
6082
6083 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
6084 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
6085 end do
6086 end if
6087
6088 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6089 h_avg = 5.e-1_wp*(h_l + h_r)
6090 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6091 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6092 vel_avg_rms = 0._wp
6093
6094
6095# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6096#if defined(MFC_OpenACC)
6097# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6098!$acc loop seq
6099# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6100#elif defined(MFC_OpenMP)
6101# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6102
6103# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6104#endif
6105 do i = 1, num_dims
6106 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6107 end do
6108 end if
6109
6110 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
6111
6112 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
6113
6114 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
6115 ! costs eight square roots per face under the Roe average.
6116 if (wave_speeds == wave_speeds_pressure) then
6117 ! Zero, not c_sum_Yi_Phi: this loop never forms the chemistry average, and
6118 ! chemistry with bubbles_euler/qbmm is prohibited, so the branch is unreachable.
6119 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, vel_avg_rms, &
6120 & h_avg, 0._wp, alpha_r, c_avg, alpha_rho_r)
6121 end if
6122
6123 if (viscous) then
6124
6125# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6126#if defined(MFC_OpenACC)
6127# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6128!$acc loop seq
6129# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6130#elif defined(MFC_OpenMP)
6131# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6132
6133# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6134#endif
6135 do i = 1, 2
6136 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6137 end do
6138 end if
6139
6140 ! Low Mach correction
6141 if (low_mach == 2) then
6142 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
6143 & vel_r(dir_idx(1)))
6144 end if
6145
6146 if (wave_speeds == wave_speeds_direct) then
6147 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6148 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6149
6150 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6151 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
6152 & - rho_r*(s_r - vel_r(dir_idx(1))))
6153 else if (wave_speeds == wave_speeds_pressure) then
6154 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6155
6156 pres_sr = pres_sl
6157
6158 ! Low Mach correction: Thornber et al. JCP (2008)
6159 ms_l = max(1._wp, &
6160 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
6161 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
6162 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
6163 ms_r = max(1._wp, &
6164 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
6165 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
6166 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
6167
6168 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6169 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6170
6171 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6172 end if
6173
6174 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6175 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6176
6177 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6178 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6179 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6180 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6181 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6182
6183 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6184 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
6185 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
6186
6187 ! Low Mach correction
6188 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
6189 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
6190
6191
6192# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6193#if defined(MFC_OpenACC)
6194# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6195!$acc loop seq
6196# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6197#elif defined(MFC_OpenMP)
6198# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6199
6200# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6201#endif
6202 do i = 1, eqn_idx%cont%end
6203 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6204 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6205 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6206 end do
6207
6208 if (bubbles_euler .and. (num_fluids > 1)) then
6209 ! Kill mass transport @ gas density
6210 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
6211 end if
6212
6213 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6214
6215 ! Include p_tilde
6216
6217 if (avg_state == avg_state_arithmetic) then
6218 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
6219 pres_l = pres_l - alpha_l(num_fluids)*pres_l
6220 else
6221 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
6222 end if
6223
6224 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
6225 pres_r = pres_r - alpha_r(num_fluids)*pres_r
6226 else
6227 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
6228 end if
6229 end if
6230
6231
6232# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6233#if defined(MFC_OpenACC)
6234# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6235!$acc loop seq
6236# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6237#elif defined(MFC_OpenMP)
6238# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6239
6240# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6241#endif
6242 do i = 1, num_dims
6243 flux_rsx_vf(j, k, l, &
6244 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
6245 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
6246 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
6247 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
6248 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
6249 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
6250 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
6251 end do
6252
6253 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
6254 flux_rsx_vf(j, k, l, &
6255 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
6256 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
6257 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
6258 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
6259 & *pcorr*s_s
6260
6261 ! Volume fraction flux
6262
6263# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6264#if defined(MFC_OpenACC)
6265# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6266!$acc loop seq
6267# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6268#elif defined(MFC_OpenMP)
6269# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6270
6271# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6272#endif
6273 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6274 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6275 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6276 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6277 end do
6278
6279 ! Advection velocity source: interface velocity for volume fraction transport
6280
6281# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6282#if defined(MFC_OpenACC)
6283# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6284!$acc loop seq
6285# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6286#elif defined(MFC_OpenMP)
6287# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6288
6289# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6290#endif
6291 do i = 1, num_dims
6292 vel_src_rsx_vf(j, k, l, &
6293 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
6294 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
6295 end do
6296
6297 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6298
6299 ! Add advection flux for bubble variables
6300
6301# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6302#if defined(MFC_OpenACC)
6303# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6304!$acc loop seq
6305# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6306#elif defined(MFC_OpenMP)
6307# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6308
6309# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6310#endif
6311 do i = eqn_idx%bub%beg, eqn_idx%bub%end
6312 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
6313 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6314 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6315 end do
6316
6317 if (qbmm) then
6318 flux_rsx_vf(j, k, l, &
6319 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6320 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6321 end if
6322
6323 if (adv_n) then
6324 flux_rsx_vf(j, k, l, &
6325 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6326 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6327 end if
6328
6329 ! Geometrical source flux for cylindrical coordinates
6330# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6331# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6332 if (grid_geometry == 3) then
6333
6334# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6335#if defined(MFC_OpenACC)
6336# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6337!$acc loop seq
6338# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6339#elif defined(MFC_OpenMP)
6340# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6341
6342# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6343#endif
6344 do i = 1, sys_size
6345 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6346 end do
6347
6348 flux_gsrc_rsx_vf(j, k, l, &
6349 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
6350 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
6351 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
6352 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
6353 end if
6354# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6355 end do
6356 end do
6357 end do
6358
6359# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6360#if defined(MFC_OpenACC)
6361# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6362!$acc end parallel loop
6363# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6364#elif defined(MFC_OpenMP)
6365# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6366
6367# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6368!$omp end target teams loop
6369# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6370#endif
6371# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6372# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6373 else if (hypoelasticity) then
6374# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6375 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
6376 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
6377 ! statement and private variable from the pure-fluid emission, keeping its body and directive
6378 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
6379 ! pinned it at the GPU register ceiling for every HLLC user.
6380 ! One source of truth for this kernel's private variables: both emissions of the shared body take
6381 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
6382 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
6383 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
6384# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6385# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6386# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6387# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6388# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6389# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6390# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6391# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6392# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6393# 880 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6394# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6395# 884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6396# 885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6397# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6398# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6399 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
6400 ! both emissions the same name; amdflang then launches the wrong one and a
6401 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
6402 ! give two line numbers. Do not merge them back into one.
6403# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6404
6405# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6406
6407# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6408#if defined(MFC_OpenACC)
6409# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6410!$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, &
6411# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6412!$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, &
6413# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6414!$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, &
6415# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6416!$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, &
6417# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6418!$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, &
6419# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6420!$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, &
6421# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6422!$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, &
6423# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6424!$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)
6425# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6426#elif defined(MFC_OpenMP)
6427# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6428
6429# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6430
6431# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6432
6433# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6434!$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, &
6435# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6436!$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, &
6437# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6438!$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, &
6439# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6440!$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, &
6441# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6442!$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, &
6443# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6444!$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, &
6445# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6446!$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, &
6447# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6448!$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, &
6449# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6450!$omp& sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
6451# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6452#endif
6453# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6454# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6455 do l = is1%beg, is1%end
6456 do k = is2%beg, is2%end
6457 do j = is3%beg, is3%end
6458 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6459 rho_l = 0._wp; rho_r = 0._wp
6460 gamma_l = 0._wp; gamma_r = 0._wp
6461 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6462 qv_l = 0._wp; qv_r = 0._wp
6463 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6464
6465
6466# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6467#if defined(MFC_OpenACC)
6468# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6469!$acc loop seq
6470# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6471#elif defined(MFC_OpenMP)
6472# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6473
6474# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6475#endif
6476 do i = 1, num_fluids
6477 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6478 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6479 end do
6480
6481
6482# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6483#if defined(MFC_OpenACC)
6484# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6485!$acc loop seq
6486# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6487#elif defined(MFC_OpenMP)
6488# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6489
6490# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6491#endif
6492 do i = 1, num_dims
6493 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6494 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
6495 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6496 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6497 end do
6498
6499 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6500 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
6501
6502# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6503
6504# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6505#if defined(MFC_OpenACC)
6506# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6507!$acc loop seq
6508# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6509#elif defined(MFC_OpenMP)
6510# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6511
6512# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6513#endif
6514 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6515 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6516 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
6517 end do
6518
6519 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
6520 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
6521 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
6522 if (n > 0) then
6523 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
6524 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
6525 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
6526 end if
6527 if (p > 0) then
6528 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
6529 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
6530 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
6531 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
6532 end if
6533 pres_tot_l = pres_l - tau_nn_l
6534 pres_tot_r = pres_r - tau_nn_r
6535 if (cyl_coord) then
6536 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
6537 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
6538 else
6539 tau_qq_l = 0._wp
6540 tau_qq_r = 0._wp
6541 end if
6542# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6543
6544 ! Change this by splitting it into the cases present in the bubbles_euler
6545 if (mpp_lim) then
6546
6547# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6548#if defined(MFC_OpenACC)
6549# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6550!$acc loop seq
6551# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6552#elif defined(MFC_OpenMP)
6553# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6554
6555# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6556#endif
6557 do i = 1, num_fluids
6558 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6559 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6560 & eqn_idx%E + i)), 1._wp)
6561 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
6562 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
6563 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
6564 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6565 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6566 end do
6567
6568
6569# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6570#if defined(MFC_OpenACC)
6571# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6572!$acc loop seq
6573# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6574#elif defined(MFC_OpenMP)
6575# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6576
6577# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6578#endif
6579 do i = 1, num_fluids
6580 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6581 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6582 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
6583 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6584 end do
6585 end if
6586
6587 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
6588 ! downstream
6589
6590# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6591#if defined(MFC_OpenACC)
6592# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6593!$acc loop seq
6594# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6595#elif defined(MFC_OpenMP)
6596# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6597
6598# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6599#endif
6600 do i = 1, num_fluids
6601 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
6602 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
6603 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6604 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6605 end do
6606
6607 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
6608 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
6609
6610 if (viscous) then
6611 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
6612 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
6613 end if
6614
6615 if (chemistry) then
6616 c_sum_yi_phi = 0.0_wp
6617
6618# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6619#if defined(MFC_OpenACC)
6620# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6621!$acc loop seq
6622# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6623#elif defined(MFC_OpenMP)
6624# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6625
6626# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6627#endif
6628 do i = eqn_idx%species%beg, eqn_idx%species%end
6629 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
6630 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
6631 end do
6632
6633 call get_mixture_molecular_weight(ys_l, mw_l)
6634 call get_mixture_molecular_weight(ys_r, mw_r)
6635
6636 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
6637 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
6638
6639 r_gas_l = gas_constant/mw_l
6640 r_gas_r = gas_constant/mw_r
6641
6642 t_l = pres_l/rho_l/r_gas_l
6643 t_r = pres_r/rho_r/r_gas_r
6644
6645 call get_species_specific_heats_r(t_l, cp_il)
6646 call get_species_specific_heats_r(t_r, cp_ir)
6647
6648 if (chem_params%gamma_method == 1) then
6649 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
6650 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
6651 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
6652
6653 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
6654 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
6655 else if (chem_params%gamma_method == 2) then
6656 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
6657 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
6658 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
6659 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
6660 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
6661
6662 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
6663 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
6664 end if
6665
6666 call get_mixture_energy_mass(t_l, ys_l, e_l)
6667 call get_mixture_energy_mass(t_r, ys_r, e_r)
6668
6669 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
6670 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
6671 h_l = (e_l + pres_l)/rho_l
6672 h_r = (e_r + pres_r)/rho_r
6673 else
6674 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
6675 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
6676
6677 h_l = (e_l + pres_l)/rho_l
6678 h_r = (e_r + pres_r)/rho_r
6679 end if
6680
6681# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6682 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6683
6684# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6685#if defined(MFC_OpenACC)
6686# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6687!$acc loop seq
6688# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6689#elif defined(MFC_OpenMP)
6690# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6691
6692# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6693#endif
6694 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6695 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6696 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
6697 end do
6698 damage_l = 0._wp; damage_r = 0._wp
6699 if (cont_damage) then
6700 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
6701 damage_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%damage)
6702 end if
6703
6704 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
6705 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
6706 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
6707 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
6708 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
6709 ! keep their pre-adjustment values here.
6710# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6711
6712 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
6713 ! average costs eight square roots per face.
6714 if (wave_speeds == wave_speeds_pressure) then
6715 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
6716 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
6717 if (chemistry .and. avg_state == avg_state_roe) then
6718 r_species(1:num_species) = gas_constant/molecular_weights
6719 call get_species_enthalpies_rt(t_l, h_il)
6720 call get_species_enthalpies_rt(t_r, h_ir)
6721 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
6722 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
6723 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
6724 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
6725 & gamma_avg, c_sum_yi_phi)
6726 end if
6727 end if
6728
6729 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
6730
6731 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
6732
6733 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
6734 ! costs eight square roots per face under the Roe average.
6735 if (wave_speeds == wave_speeds_pressure) then
6736 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
6737 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
6738 & alpha_rho_r)
6739 end if
6740
6741 if (viscous) then
6742 if (chemistry) then
6743 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
6744 end if
6745
6746# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6747#if defined(MFC_OpenACC)
6748# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6749!$acc loop seq
6750# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6751#elif defined(MFC_OpenMP)
6752# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6753
6754# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6755#endif
6756 do i = 1, 2
6757 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6758 end do
6759 end if
6760
6761 ! Low Mach correction
6762 if (low_mach == 2) then
6763 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
6764 & vel_r(dir_idx(1)))
6765 end if
6766
6767 if (wave_speeds == wave_speeds_direct) then
6768# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6769 ! Elastic wave speed, Rodriguez et al. JCP (2019)
6770 s_l = min(vel_l(dir_idx(1)) - f_elastic_signal_speed(c_l, g_l, &
6771 & tau_e_l(dir_idx_tau(1)), rho_l), &
6772 & vel_r(dir_idx(1)) - f_elastic_signal_speed(c_r, g_r, &
6773 & tau_e_r(dir_idx_tau(1)), rho_r))
6774 s_r = max(vel_r(dir_idx(1)) + f_elastic_signal_speed(c_r, g_r, &
6775 & tau_e_r(dir_idx_tau(1)), rho_r), &
6776 & vel_l(dir_idx(1)) + f_elastic_signal_speed(c_l, g_l, &
6777 & tau_e_l(dir_idx_tau(1)), rho_l))
6778 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
6779 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
6780 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
6781 & - vel_r(dir_idx(1))))
6782# 1150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6783 else if (wave_speeds == wave_speeds_pressure) then
6784 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6785
6786 pres_sr = pres_sl
6787
6788 ! Low Mach correction: Thornber et al. JCP (2008)
6789 ms_l = max(1._wp, &
6790 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
6791 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
6792 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
6793 ms_r = max(1._wp, &
6794 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
6795 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
6796 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
6797
6798 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6799 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6800
6801 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6802 end if
6803
6804 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6805 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6806
6807 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6808 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6809 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6810 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
6811 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6812 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6813
6814 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6815 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
6816 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
6817
6818 ! Low Mach correction
6819 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
6820 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
6821
6822# 1190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6823 if (n == 0) then
6824 u_t_l = 0._wp; u_t_r = 0._wp
6825 tau_nt_l = 0._wp; tau_nt_r = 0._wp
6826 end if
6827 if (p == 0) then
6828 u_t2_l = 0._wp; u_t2_r = 0._wp
6829 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
6830 end if
6831 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
6832 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
6833 denom_a = a_r - a_l
6834 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
6835 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
6836 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
6837 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
6838 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
6839# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6840
6841 ! COMPUTING THE HLLC FLUXES MASS FLUX.
6842
6843# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6844#if defined(MFC_OpenACC)
6845# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6846!$acc loop seq
6847# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6848#elif defined(MFC_OpenMP)
6849# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6850
6851# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6852#endif
6853 do i = 1, eqn_idx%cont%end
6854 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6855 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6856 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6857 end do
6858
6859# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6860 flux_rsx_vf(j, k, l, &
6861 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
6862 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
6863 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
6864 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
6865 if (n > 0) then
6866 flux_rsx_vf(j, k, l, &
6867 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
6868 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
6869 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
6870 & - tau_nt_r)
6871 end if
6872 if (p > 0) then
6873 flux_rsx_vf(j, k, l, &
6874 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
6875 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
6876 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
6877 & - tau_nt2_r)
6878 end if
6879
6880 flux_rsx_vf(j, k, l, &
6881 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
6882 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
6883 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
6884 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
6885 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
6886 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
6887 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
6888 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
6889 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
6890 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
6891
6892 if (n == 0) then
6893 flux_rsx_vf(j, k, l, &
6894 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
6895 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
6896 & + s_p*(xi_r - 1._wp))
6897 else if (p == 0) then
6898 if (dir_idx(1) == 1) then
6899 flux_rsx_vf(j, k, l, &
6900 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
6901 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
6902 & + s_p*(xi_r - 1._wp))
6903 flux_rsx_vf(j, k, l, &
6904 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
6905 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
6906 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
6907 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
6908 flux_rsx_vf(j, k, l, &
6909 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
6910 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
6911 & + s_p*(xi_r - 1._wp))
6912 else
6913 flux_rsx_vf(j, k, l, &
6914 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
6915 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
6916 & + s_p*(xi_r - 1._wp))
6917 flux_rsx_vf(j, k, l, &
6918 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
6919 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
6920 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
6921 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
6922 flux_rsx_vf(j, k, l, &
6923 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
6924 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
6925 & + s_p*(xi_r - 1._wp))
6926 end if
6927 else
6928 flux_rsx_vf(j, k, l, &
6929 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
6930 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
6931 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
6932 flux_rsx_vf(j, k, l, &
6933 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
6934 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
6935 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
6936 & - rho_r*tau_nt_r))
6937 flux_rsx_vf(j, k, l, &
6938 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
6939 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
6940 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
6941 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
6942 flux_rsx_vf(j, k, l, &
6943 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
6944 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
6945 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
6946 flux_rsx_vf(j, k, l, &
6947 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
6948 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
6949 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
6950 flux_rsx_vf(j, k, l, &
6951 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
6952 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
6953 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
6954 end if
6955 if (cyl_coord) then
6956 flux_rsx_vf(j, k, l, &
6957 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
6958 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
6959 & + s_p*(xi_r - 1._wp))
6960 end if
6961
6962 ! Damage flux: U_D = m_s*D (damageable-solid partial mass)
6963 if (cont_damage) then
6964 solid_partial_density_l = 0._wp; solid_partial_density_r = 0._wp
6965
6966# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6967#if defined(MFC_OpenACC)
6968# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6969!$acc loop seq
6970# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6971#elif defined(MFC_OpenMP)
6972# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6973
6974# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6975#endif
6976 do i = 1, num_fluids
6977 if (gs_rs(i) > verysmall) then
6978 solid_partial_density_l = solid_partial_density_l + alpha_rho_l(i)
6979 solid_partial_density_r = solid_partial_density_r + alpha_rho_r(i)
6980 end if
6981 end do
6982 flux_rsx_vf(j, k, l, &
6983 & eqn_idx%damage) &
6984 & = xi_m*solid_partial_density_l*damage_l*(vel_l(dir_idx(1)) + s_m*(xi_l &
6985 & - 1._wp)) + xi_p*solid_partial_density_r*damage_r*(vel_r(dir_idx(1)) &
6986 & + s_p*(xi_r - 1._wp))
6987 end if
6988
6989 if (s_l >= 0._wp) then
6990 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
6991 else if (s_r <= 0._wp) then
6992 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
6993 else
6994 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
6995 end if
6996 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
6997 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
6998 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
6999# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7000
7001 ! VOLUME FRACTION FLUX.
7002
7003# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7004#if defined(MFC_OpenACC)
7005# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7006!$acc loop seq
7007# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7008#elif defined(MFC_OpenMP)
7009# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7010
7011# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7012#endif
7013 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7014 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7015 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7016 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7017 end do
7018
7019 ! VOLUME FRACTION SOURCE FLUX.
7020
7021# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7022#if defined(MFC_OpenACC)
7023# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7024!$acc loop seq
7025# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7026#elif defined(MFC_OpenMP)
7027# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7028
7029# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7030#endif
7031 do i = 1, num_dims
7032 vel_src_rsx_vf(j, k, l, &
7033 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
7034 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
7035 end do
7036
7037 ! COLOR FUNCTION FLUX
7038 if (surface_tension) then
7039 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
7040 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7041 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7042 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7043 end if
7044
7045 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7046
7047 if (chemistry) then
7048
7049# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7050#if defined(MFC_OpenACC)
7051# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7052!$acc loop seq
7053# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7054#elif defined(MFC_OpenMP)
7055# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7056
7057# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7058#endif
7059 do i = eqn_idx%species%beg, eqn_idx%species%end
7060 y_l = ql_prim_rsx_vf(j, k, l, i)
7061 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
7062
7063 flux_rsx_vf(j, k, l, &
7064 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7065 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7066 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
7067 end do
7068 end if
7069
7070# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7071 ! HLLC-ADC blending for hypoelasticity
7072 if (riemann_hypo_adc) then
7073 ! Build U_L, U_R and F_L, F_R in local-basis layout
7074
7075# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7076#if defined(MFC_OpenACC)
7077# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7078!$acc loop seq
7079# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7080#elif defined(MFC_OpenMP)
7081# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7082
7083# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7084#endif
7085 do i = 1, num_fluids
7086 u_l(i) = alpha_rho_l(i)
7087 u_r(i) = alpha_rho_r(i)
7088 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
7089 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
7090 f_l(i) = alpha_rho_l(i)*u_n_l
7091 f_r(i) = alpha_rho_r(i)*u_n_r
7092 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
7093 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
7094 end do
7095
7096 ! Momentum U/F in physical order via dir_idx
7097 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
7098 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
7099 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
7100 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
7101 if (n > 0) then
7102 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
7103 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
7104 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
7105 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
7106 end if
7107 if (p > 0) then
7108 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
7109 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
7110 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
7111 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
7112 end if
7113
7114 u_l(eqn_idx%E) = e_l
7115 u_r(eqn_idx%E) = e_r
7116 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
7117 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
7118
7119 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
7120
7121# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7122#if defined(MFC_OpenACC)
7123# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7124!$acc loop seq
7125# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7126#elif defined(MFC_OpenMP)
7127# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7128
7129# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7130#endif
7131 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
7132 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
7133 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
7134 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
7135 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
7136 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
7137 end do
7138 if (cyl_coord) then
7139 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
7140 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
7141 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
7142 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
7143 end if
7144
7145 ! Compute F_HLL (physical order) and HLL trace velocities
7146 if (s_l >= 0._wp) then
7147
7148# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7149#if defined(MFC_OpenACC)
7150# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7151!$acc loop seq
7152# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7153#elif defined(MFC_OpenMP)
7154# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7155
7156# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7157#endif
7158 do i = 1, sys_size
7159 f_hll(i) = f_l(i)
7160 end do
7161 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
7162 else if (s_r <= 0._wp) then
7163
7164# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7165#if defined(MFC_OpenACC)
7166# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7167!$acc loop seq
7168# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7169#elif defined(MFC_OpenMP)
7170# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7171
7172# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7173#endif
7174 do i = 1, sys_size
7175 f_hll(i) = f_r(i)
7176 end do
7177 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
7178 else
7179
7180# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7181#if defined(MFC_OpenACC)
7182# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7183!$acc loop seq
7184# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7185#elif defined(MFC_OpenMP)
7186# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7187
7188# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7189#endif
7190 do i = 1, sys_size
7191 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 &
7192 & + verysmall)
7193 end do
7194 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
7195 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
7196 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
7197 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
7198 end if
7199
7200 ! ADC sensor
7201 sigma_l = pres_tot_l
7202 sigma_r = pres_tot_r
7203 dsigma = sigma_r - sigma_l
7204 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
7205
7206 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
7207 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
7208 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
7209
7210 du_t = u_t_r - u_t_l
7211 dtau_nt = tau_nt_r - tau_nt_l
7212 du_t2 = u_t2_r - u_t2_l
7213 dtau_nt2 = tau_nt2_r - tau_nt2_l
7214
7215 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
7216 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
7217 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
7218 & + verysmall)
7219
7220 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
7221 phi = exp(-(sensor_combined**adc_power))
7222
7223 ! Blend all flux components: F_HLL is in physical order
7224
7225# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7226#if defined(MFC_OpenACC)
7227# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7228!$acc loop seq
7229# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7230#elif defined(MFC_OpenMP)
7231# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7232
7233# 1514 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7234#endif
7235 do i = 1, sys_size
7236 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
7237 end do
7238
7239 ! Blend interface velocities (scalar HLL traces)
7240 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
7241 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
7242 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
7243
7244 ! Overwrite vel_src with blended velocities
7245 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
7246 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
7247 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
7248
7249 ! Update advection source flux with ADC-blended face-normal velocity
7250 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
7251
7252 ! Overwrite nc_iface_vel with blended velocities
7253 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
7254 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
7255 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
7256 end if
7257 ! END HLLC-ADC
7258# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7259
7260 ! Geometrical source flux for cylindrical coordinates
7261# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7262# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7263 if (grid_geometry == 3) then
7264
7265# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7266#if defined(MFC_OpenACC)
7267# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7268!$acc loop seq
7269# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7270#elif defined(MFC_OpenMP)
7271# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7272
7273# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7274#endif
7275 do i = 1, sys_size
7276 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7277 end do
7278
7279 flux_gsrc_rsx_vf(j, k, l, &
7280 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
7281 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
7282 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
7283 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, &
7284 & eqn_idx%mom%beg + 1)
7285 end if
7286# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7287 end do
7288 end do
7289 end do
7290
7291# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7292#if defined(MFC_OpenACC)
7293# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7294!$acc end parallel loop
7295# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7296#elif defined(MFC_OpenMP)
7297# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7298
7299# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7300!$omp end target teams loop
7301# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7302#endif
7303# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7304# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7305 else
7306# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7307 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
7308 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
7309 ! statement and private variable from the pure-fluid emission, keeping its body and directive
7310 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
7311 ! pinned it at the GPU register ceiling for every HLLC user.
7312 ! One source of truth for this kernel's private variables: both emissions of the shared body take
7313 ! _hllc_s*, and only the hypoelastic one adds _hllc_e*. Two hand-written lists drifted apart once --
7314 ! c_sum_Yi_Phi was private in one and shared in the other, which races under OpenMP offload.
7315 ! Names are lists joined once, so no fragment carries a trailing separator to get wrong.
7316# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7317# 864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7318# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7319# 868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7320# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7321# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7322# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7323# 876 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7324# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7325# 880 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7326# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7327# 884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7328# 889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7329# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7330# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7331 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
7332 ! both emissions the same name; amdflang then launches the wrong one and a
7333 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
7334 ! give two line numbers. Do not merge them back into one.
7335# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7336
7337# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7338
7339# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7340#if defined(MFC_OpenACC)
7341# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7342!$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, &
7343# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7344!$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, &
7345# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7346!$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, &
7347# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7348!$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)
7349# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7350#elif defined(MFC_OpenMP)
7351# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7352
7353# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7354
7355# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7356
7357# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7358!$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, &
7359# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7360!$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, &
7361# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7362!$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, &
7363# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7364!$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, &
7365# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7366!$omp& Cp_iR, R_species, h_iL, h_iR) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
7367# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7368#endif
7369# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7370# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7371 do l = is1%beg, is1%end
7372 do k = is2%beg, is2%end
7373 do j = is3%beg, is3%end
7374 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7375 rho_l = 0._wp; rho_r = 0._wp
7376 gamma_l = 0._wp; gamma_r = 0._wp
7377 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7378 qv_l = 0._wp; qv_r = 0._wp
7379 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
7380
7381
7382# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7383#if defined(MFC_OpenACC)
7384# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7385!$acc loop seq
7386# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7387#elif defined(MFC_OpenMP)
7388# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7389
7390# 913 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7391#endif
7392 do i = 1, num_fluids
7393 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7394 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7395 end do
7396
7397
7398# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7399#if defined(MFC_OpenACC)
7400# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7401!$acc loop seq
7402# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7403#elif defined(MFC_OpenMP)
7404# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7405
7406# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7407#endif
7408 do i = 1, num_dims
7409 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7410 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7411 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7412 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7413 end do
7414
7415 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7416 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7417
7418# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7419
7420 ! Change this by splitting it into the cases present in the bubbles_euler
7421 if (mpp_lim) then
7422
7423# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7424#if defined(MFC_OpenACC)
7425# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7426!$acc loop seq
7427# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7428#elif defined(MFC_OpenMP)
7429# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7430
7431# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7432#endif
7433 do i = 1, num_fluids
7434 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
7435 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
7436 & eqn_idx%E + i)), 1._wp)
7437 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
7438 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
7439 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
7440 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7441 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7442 end do
7443
7444
7445# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7446#if defined(MFC_OpenACC)
7447# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7448!$acc loop seq
7449# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7450#elif defined(MFC_OpenMP)
7451# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7452
7453# 976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7454#endif
7455 do i = 1, num_fluids
7456 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
7457 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
7458 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
7459 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
7460 end do
7461 end if
7462
7463 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
7464 ! downstream
7465
7466# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7467#if defined(MFC_OpenACC)
7468# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7469!$acc loop seq
7470# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7471#elif defined(MFC_OpenMP)
7472# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7473
7474# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7475#endif
7476 do i = 1, num_fluids
7477 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7478 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7479 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7480 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7481 end do
7482
7483 call s_compute_mixture_coefficients(alpha_rho_l, alpha_lim_l, rho_l, gamma_l, pi_inf_l, qv_l)
7484 call s_compute_mixture_coefficients(alpha_rho_r, alpha_lim_r, rho_r, gamma_r, pi_inf_r, qv_r)
7485
7486 if (viscous) then
7487 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
7488 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
7489 end if
7490
7491 if (chemistry) then
7492 c_sum_yi_phi = 0.0_wp
7493
7494# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7495#if defined(MFC_OpenACC)
7496# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7497!$acc loop seq
7498# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7499#elif defined(MFC_OpenMP)
7500# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7501
7502# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7503#endif
7504 do i = eqn_idx%species%beg, eqn_idx%species%end
7505 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
7506 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
7507 end do
7508
7509 call get_mixture_molecular_weight(ys_l, mw_l)
7510 call get_mixture_molecular_weight(ys_r, mw_r)
7511
7512 xs_l(1:num_species) = ys_l(1:num_species)*mw_l/molecular_weights(:)
7513 xs_r(1:num_species) = ys_r(1:num_species)*mw_r/molecular_weights(:)
7514
7515 r_gas_l = gas_constant/mw_l
7516 r_gas_r = gas_constant/mw_r
7517
7518 t_l = pres_l/rho_l/r_gas_l
7519 t_r = pres_r/rho_r/r_gas_r
7520
7521 call get_species_specific_heats_r(t_l, cp_il)
7522 call get_species_specific_heats_r(t_r, cp_ir)
7523
7524 if (chem_params%gamma_method == 1) then
7525 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
7526 gamma_il(1:num_species) = cp_il(1:num_species)/(cp_il(1:num_species) - 1.0_wp)
7527 gamma_ir(1:num_species) = cp_ir(1:num_species)/(cp_ir(1:num_species) - 1.0_wp)
7528
7529 gamma_l = sum(xs_l(1:num_species)/(gamma_il(1:num_species) - 1.0_wp))
7530 gamma_r = sum(xs_r(1:num_species)/(gamma_ir(1:num_species) - 1.0_wp))
7531 else if (chem_params%gamma_method == 2) then
7532 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
7533 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
7534 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
7535 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
7536 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
7537
7538 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
7539 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
7540 end if
7541
7542 call get_mixture_energy_mass(t_l, ys_l, e_l)
7543 call get_mixture_energy_mass(t_r, ys_r, e_r)
7544
7545 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
7546 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
7547 h_l = (e_l + pres_l)/rho_l
7548 h_r = (e_r + pres_r)/rho_r
7549 else
7550 call s_compute_energy(pres_l, alpha_rho_l, alpha_lim_l, vel_l_rms, e_l)
7551 call s_compute_energy(pres_r, alpha_rho_r, alpha_lim_r, vel_r_rms, e_r)
7552
7553 h_l = (e_l + pres_l)/rho_l
7554 h_r = (e_r + pres_r)/rho_r
7555 end if
7556
7557# 1079 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7558 h_l = (e_l + pres_l)/rho_l
7559 h_r = (e_r + pres_r)/rho_r
7560# 1082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7561
7562 ! Only the pressure-based wave-speed estimate reads the averaged state, and the Roe
7563 ! average costs eight square roots per face.
7564 if (wave_speeds == wave_speeds_pressure) then
7565 call s_compute_average_state(rho_l, rho_r, vel_l, vel_r, h_l, h_r, gamma_l, gamma_r, &
7566 & qv_l, qv_r, rho_avg, vel_avg_rms, h_avg, gamma_avg, qv_avg)
7567 if (chemistry .and. avg_state == avg_state_roe) then
7568 r_species(1:num_species) = gas_constant/molecular_weights
7569 call get_species_enthalpies_rt(t_l, h_il)
7570 call get_species_enthalpies_rt(t_r, h_ir)
7571 h_il(1:num_species) = h_il(1:num_species)*r_species(1:num_species)*t_l
7572 h_ir(1:num_species) = h_ir(1:num_species)*r_species(1:num_species)*t_r
7573 call s_compute_chemistry_average_state(rho_l, rho_r, t_l, t_r, ys_l, ys_r, r_species, &
7574 & h_il, h_ir, cp_il, cp_ir, vel_avg_rms, &
7575 & gamma_avg, c_sum_yi_phi)
7576 end if
7577 end if
7578
7579 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, alpha_l, c_l, alpha_rho_l)
7580
7581 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, alpha_r, c_r, alpha_rho_r)
7582
7583 ! Only the pressure-based wave-speed estimate reads the averaged state, and building it
7584 ! costs eight square roots per face under the Roe average.
7585 if (wave_speeds == wave_speeds_pressure) then
7586 call s_compute_speed_of_sound_avg(pres_r, rho_avg, gamma_avg, pi_inf_r, qv_avg, &
7587 & vel_avg_rms, h_avg, c_sum_yi_phi, alpha_r, c_avg, &
7588 & alpha_rho_r)
7589 end if
7590
7591 if (viscous) then
7592 if (chemistry) then
7593 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
7594 end if
7595
7596# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7597#if defined(MFC_OpenACC)
7598# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7599!$acc loop seq
7600# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7601#elif defined(MFC_OpenMP)
7602# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7603
7604# 1116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7605#endif
7606 do i = 1, 2
7607 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7608 end do
7609 end if
7610
7611 ! Low Mach correction
7612 if (low_mach == 2) then
7613 call s_apply_low_mach_velocity(vel_l_rms, vel_r_rms, c_l, c_r, vel_l(dir_idx(1)), &
7614 & vel_r(dir_idx(1)))
7615 end if
7616
7617 if (wave_speeds == wave_speeds_direct) then
7618# 1144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7619 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7620 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7621 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7622 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
7623 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7624# 1150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7625 else if (wave_speeds == wave_speeds_pressure) then
7626 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7627
7628 pres_sr = pres_sl
7629
7630 ! Low Mach correction: Thornber et al. JCP (2008)
7631 ms_l = max(1._wp, &
7632 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_l) + 1._wp) &
7633 & /f_isentrope_exponent(gamma_l)*(pres_sl - pres_l)/(pres_l &
7634 & + f_isentrope_pressure(pi_inf_l, gamma_l))))
7635 ms_r = max(1._wp, &
7636 & sqrt(1._wp + 5.e-1_wp*(f_isentrope_exponent(gamma_r) + 1._wp) &
7637 & /f_isentrope_exponent(gamma_r)*(pres_sr - pres_r)/(pres_r &
7638 & + f_isentrope_pressure(pi_inf_r, gamma_r))))
7639
7640 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7641 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7642
7643 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7644 end if
7645
7646 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7647 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7648
7649 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7650 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7651 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7652 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
7653 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7654 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7655
7656 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7657 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7658 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7659
7660 ! Low Mach correction
7661 pcorr = f_low_mach_pcorr_hllc(vel_l_rms, vel_r_rms, c_l, c_r, rho_l, rho_r, s_l, s_r, &
7662 & vel_l(dir_idx(1)), vel_r(dir_idx(1)))
7663
7664# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7665
7666 ! COMPUTING THE HLLC FLUXES MASS FLUX.
7667
7668# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7669#if defined(MFC_OpenACC)
7670# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7671!$acc loop seq
7672# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7673#elif defined(MFC_OpenMP)
7674# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7675
7676# 1209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7677#endif
7678 do i = 1, eqn_idx%cont%end
7679 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7680 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7681 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7682 end do
7683
7684# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7685
7686# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7687#if defined(MFC_OpenACC)
7688# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7689!$acc loop seq
7690# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7691#elif defined(MFC_OpenMP)
7692# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7693
7694# 1347 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7695#endif
7696 do i = 1, num_dims
7697 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
7698 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
7699 flux_rsx_vf(j, k, l, &
7700 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
7701 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
7702 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
7703 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7704 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
7705 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
7706 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7707 end do
7708
7709 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7710 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
7711 flux_rsx_vf(j, k, l, &
7712 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
7713 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
7714 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
7715 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
7716 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7717# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7718
7719 ! VOLUME FRACTION FLUX.
7720
7721# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7722#if defined(MFC_OpenACC)
7723# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7724!$acc loop seq
7725# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7726#elif defined(MFC_OpenMP)
7727# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7728
7729# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7730#endif
7731 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7732 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7733 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7734 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7735 end do
7736
7737 ! VOLUME FRACTION SOURCE FLUX.
7738
7739# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7740#if defined(MFC_OpenACC)
7741# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7742!$acc loop seq
7743# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7744#elif defined(MFC_OpenMP)
7745# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7746
7747# 1380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7748#endif
7749 do i = 1, num_dims
7750 vel_src_rsx_vf(j, k, l, &
7751 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
7752 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
7753 end do
7754
7755 ! COLOR FUNCTION FLUX
7756 if (surface_tension) then
7757 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
7758 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7759 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7760 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7761 end if
7762
7763 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7764
7765 if (chemistry) then
7766
7767# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7768#if defined(MFC_OpenACC)
7769# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7770!$acc loop seq
7771# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7772#elif defined(MFC_OpenMP)
7773# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7774
7775# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7776#endif
7777 do i = eqn_idx%species%beg, eqn_idx%species%end
7778 y_l = ql_prim_rsx_vf(j, k, l, i)
7779 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
7780
7781 flux_rsx_vf(j, k, l, &
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 end do
7786 end if
7787
7788# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7789
7790 ! Geometrical source flux for cylindrical coordinates
7791# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7792# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7793 if (grid_geometry == 3) then
7794
7795# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7796#if defined(MFC_OpenACC)
7797# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7798!$acc loop seq
7799# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7800#elif defined(MFC_OpenMP)
7801# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7802
7803# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7804#endif
7805 do i = 1, sys_size
7806 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7807 end do
7808
7809 flux_gsrc_rsx_vf(j, k, l, &
7810 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
7811 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
7812 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
7813 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, &
7814 & eqn_idx%mom%beg + 1)
7815 end if
7816# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7817 end do
7818 end do
7819 end do
7820
7821# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7822#if defined(MFC_OpenACC)
7823# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7824!$acc end parallel loop
7825# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7826#elif defined(MFC_OpenMP)
7827# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7828
7829# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7830!$omp end target teams loop
7831# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7832#endif
7833# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7834 end if
7835 end if
7836# 1609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7837 ! Computing HLLC flux and source flux for Euler system of equations
7838
7839 if (viscous) then
7840 if (weno_re_flux) then
7841 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7842 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7843 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7844 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7845 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7846 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7847 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7848 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
7849 & norm_dir, ix, iy, iz)
7850 else
7851 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7852 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7853 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7854 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7855 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7856 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7857 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
7858 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
7859 & norm_dir, ix, iy, iz)
7860 end if
7861 end if
7862
7863 if (surface_tension) then
7864 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
7865 end if
7866
7867 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
7868
7869 end subroutine s_hllc_riemann_solver
7870
7871end 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:335
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:373
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:373
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:373
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged model.
Definition m_bubbles.fpp.f90:335
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:620
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:347
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:388
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:148
m_constants::avg_state_roe
integer, parameter avg_state_roe
Definition m_constants.fpp.f90:131
m_constants::wave_speeds_direct
integer, parameter wave_speeds_direct
Definition m_constants.fpp.f90:169
m_constants::riemann_solver_hll
integer, parameter riemann_solver_hll
Definition m_constants.fpp.f90:162
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:163
m_constants::wave_speeds_pressure
integer, parameter wave_speeds_pressure
Definition m_constants.fpp.f90:170
m_constants::riemann_solver_lax_friedrichs
integer, parameter riemann_solver_lax_friedrichs
Definition m_constants.fpp.f90:165
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:132
m_constants::model_eqns_6eq
integer, parameter model_eqns_6eq
Definition m_constants.fpp.f90:149
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:335
m_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:381
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:1515
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:2215
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:1677
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:1137
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:1919
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:2088
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:1091
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:346
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:388
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:898
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:787
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:789
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:899
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:788
m_global_parameters::stress_perm
integer, dimension(6) stress_perm
Full tensor permutation: local basis -> physical storage index.
Definition m_global_parameters.fpp.f90:790
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:882
m_riemann_solver_hllc
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solver_hllc.fpp.f90:346
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:371
m_riemann_state
Shared Riemann-solver module state and the per-sweep setup, state-buffer population,...
Definition m_riemann_state.fpp.f90:347
m_riemann_state::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_state.fpp.f90:360
m_riemann_state::isz
type(int_bounds_info) isz
Definition m_riemann_state.fpp.f90:490
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:798
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:536
m_riemann_state::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_state.fpp.f90:461
m_riemann_state::isx
type(int_bounds_info) isx
Definition m_riemann_state.fpp.f90:490
m_riemann_state::is3
type(int_bounds_info) is3
Definition m_riemann_state.fpp.f90:489
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:360
m_riemann_state::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_state.fpp.f90:518
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:899
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:684
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:2088
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:984
m_riemann_state::nc_iface_vel_rsx_vf
real(wp), dimension(:,:,:,:), allocatable nc_iface_vel_rsx_vf
Definition m_riemann_state.fpp.f90:390
m_riemann_state::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_state.fpp.f90:505
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:1006
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:3146
m_riemann_state::isy
type(int_bounds_info) isy
Definition m_riemann_state.fpp.f90:490
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:3251
m_riemann_state::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_state.fpp.f90:448
m_riemann_state::is2
type(int_bounds_info) is2
Definition m_riemann_state.fpp.f90:489
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:3311
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:3056
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:377
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:741
m_riemann_state::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_state.fpp.f90:474
m_riemann_state::is1
type(int_bounds_info) is1
Definition m_riemann_state.fpp.f90:489
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:346
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:677
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:346
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:2344
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:429
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:349