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# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44
45# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46! New line at end of file is required for FYPP
47# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
48# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
49# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
50# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75! New line at end of file is required for FYPP
76# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
77
78# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154! New line at end of file is required for FYPP
155# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
156# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
157# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
158# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183! New line at end of file is required for FYPP
184# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
185
186# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241! New line at end of file is required for FYPP
242# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
243
244! GPU parallel region (scalar reductions, maxval/minval)
245# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! GPU parallel loop over threads (most common GPU macro)
248# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Required closing for GPU_PARALLEL_LOOP
251# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Mark routine for device compilation
254# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Declare device-resident data
257# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Inner loop within a GPU parallel region
260# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Scoped GPU data region
263# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Host code with device pointers (for MPI with GPU buffers)
266# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Allocate device memory (unscoped)
269# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Free device memory
272# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Atomic operation on device
275# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! End atomic capture block
278# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Copy data between host and device
281# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Synchronization barrier
284# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Import GPU library module (openacc or omp_lib)
287# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Emit code only for AMD compiler
290# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Emit code for non-Cray compilers
293# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Emit code only for Cray compiler
296# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Emit code for non-NVIDIA compilers
299# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303! New line at end of file is required for FYPP
304# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
305
306# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
309! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
310! example see misc/nvidia_uvm/bind.sh.
311# 55 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Allocate and create GPU device memory
314# 75 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Free GPU device memory and deallocate
317# 83 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for vector fields
320# 107 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322! Cray-specific GPU pointer setup for scalar fields
323# 123 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325! Cray-specific GPU pointer setup for acoustic source spatials
326# 148 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 154 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329
330# 161 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
331! New line at end of file is required for FYPP
332# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
333# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
334# 13 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
335
336# 60 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
337
338# 70 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
339
340# 94 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
341
342# 109 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
343
344# 116 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
345# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
346
347module m_riemann_solver_hllc
348
349 use m_derived_types
350 use m_global_parameters
351 use m_variables_conversion
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
397 real(wp), dimension(num_species) :: Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2
398# 70 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
399 real(wp) :: Cp_avg, Cv_avg, T_avg, c_sum_Yi_Phi, eps
400 real(wp) :: T_L, T_R
401 real(wp) :: MW_L, MW_R
402 real(wp) :: R_gas_L, R_gas_R
403 real(wp) :: Cp_L, Cp_R
404 real(wp) :: Cv_L, Cv_R
405 real(wp) :: Gamm_L, Gamm_R
406 real(wp) :: Y_L, Y_R
407 real(wp) :: gamma_L, gamma_R
408 real(wp) :: pi_inf_L, pi_inf_R
409 real(wp) :: qv_L, qv_R
410 real(wp) :: c_L, c_R
411 real(wp), dimension(2) :: Re_L, Re_R
412 real(wp) :: rho_avg
413 real(wp) :: H_avg
414 real(wp) :: gamma_avg
415 real(wp) :: qv_avg
416 real(wp) :: c_avg
417 real(wp) :: s_L, s_R, s_M, s_P, s_S
418 real(wp) :: xi_L, xi_R !< Left and right wave speeds functions
419 real(wp) :: xi_L_m1, xi_R_m1 !< xi_L/R - 1, computed without cancellation
420 real(wp) :: xi_M, xi_P
421 real(wp) :: xi_MP, xi_PP
422# 99 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
423 real(wp), dimension(nb) :: R0_L, R0_R
424 real(wp), dimension(nb) :: V0_L, V0_R
425 real(wp), dimension(nb) :: P0_L, P0_R
426 real(wp), dimension(nb) :: pbw_L, pbw_R
427# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
428
429 real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L, nbub_R
430 real(wp) :: ptilde_L, ptilde_R
431 real(wp) :: PbwR3Lbar, PbwR3Rbar
432 real(wp) :: R3Lbar, R3Rbar
433 real(wp) :: R3V2Lbar, R3V2Rbar
434 real(wp), dimension(6) :: tau_e_L, tau_e_R
435 real(wp) :: G_L, G_R
436 real(wp) :: damage_L, damage_R
437 real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms
438 real(wp) :: vel_L_tmp, vel_R_tmp
439 real(wp) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_star
440 real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R
441 real(wp) :: zcoef, 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, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, &
506# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
507!$acc& 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, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, &
508# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
509!$acc& vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, &
510# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
511!$acc& xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP) 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, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, pcorr, zcoef, rho_L, rho_R, &
524# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
525!$omp& pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, &
526# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
527!$omp& 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, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, &
528# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
529!$omp& 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) &
530# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
531!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
532# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
533#endif
534# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
535 do l = is3%beg, is3%end
536 do k = is2%beg, is2%end
537 do j = is1%beg, is1%end
538 vel_l_rms = 0._wp; vel_r_rms = 0._wp
539 rho_l = 0._wp; rho_r = 0._wp
540 gamma_l = 0._wp; gamma_r = 0._wp
541 pi_inf_l = 0._wp; pi_inf_r = 0._wp
542 qv_l = 0._wp; qv_r = 0._wp
543 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
544
545
546# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
547#if defined(MFC_OpenACC)
548# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
549!$acc loop seq
550# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
551#elif defined(MFC_OpenMP)
552# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
553
554# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
555#endif
556 do i = 1, num_dims
557 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
558 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
559 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
560 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
561 end do
562
563 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
564 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
565
566 rho_l = 0._wp
567 gamma_l = 0._wp
568 pi_inf_l = 0._wp
569 qv_l = 0._wp
570
571 rho_r = 0._wp
572 gamma_r = 0._wp
573 pi_inf_r = 0._wp
574 qv_r = 0._wp
575
576 alpha_l_sum = 0._wp
577 alpha_r_sum = 0._wp
578
579 if (mpp_lim) then
580
581# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
582#if defined(MFC_OpenACC)
583# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
584!$acc loop seq
585# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
586#elif defined(MFC_OpenMP)
587# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
588
589# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
590#endif
591 do i = 1, num_fluids
592 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
593 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
594 & eqn_idx%E + i)), 1._wp)
595 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
596 end do
597
598
599# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
600#if defined(MFC_OpenACC)
601# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
602!$acc loop seq
603# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
604#elif defined(MFC_OpenMP)
605# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
606
607# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
608#endif
609 do i = 1, num_fluids
610 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
611 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
612 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
613 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
614 end do
615
616
617# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
618#if defined(MFC_OpenACC)
619# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
620!$acc loop seq
621# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
622#elif defined(MFC_OpenMP)
623# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
624
625# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
626#endif
627 do i = 1, num_fluids
628 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
629 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
630 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
631 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
632 end do
633 end if
634
635
636# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
637#if defined(MFC_OpenACC)
638# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
639!$acc loop seq
640# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
641#elif defined(MFC_OpenMP)
642# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
643
644# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
645#endif
646 do i = 1, num_fluids
647 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
648 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
649 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
650 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
651 end do
652
653 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
654 & qv_l)
655 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
656 & qv_r)
657
658 if (viscous) then
659 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
660 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
661 end if
662
663 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
664 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
665
666 h_l = (e_l + pres_l)/rho_l
667 h_r = (e_r + pres_r)/rho_r
668
669 if (avg_state == avg_state_roe) then
670# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
671 rho_avg = sqrt(rho_l*rho_r)
672# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
673
674# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
675 vel_avg_rms = 0._wp
676# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
677
678# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
679
680# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
681#if defined(MFC_OpenACC)
682# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
683!$acc loop seq
684# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
685#elif defined(MFC_OpenMP)
686# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
687
688# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
689#endif
690# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
691 do i = 1, num_vels
692# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
693 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
694# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
695 end do
696# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
697
698# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
699 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
700# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
701
702# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
703 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
704# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
705
706# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
707 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
708# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
709
710# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
711 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
712# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
713
714# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
715 if (chemistry) then
716# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
717 eps = 0.001_wp
718# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
719 call get_species_enthalpies_rt(t_l, h_il)
720# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
721 call get_species_enthalpies_rt(t_r, h_ir)
722# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
723 h_il = h_il*gas_constant/molecular_weights*t_l
724# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
725 h_ir = h_ir*gas_constant/molecular_weights*t_r
726# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
727 call get_species_specific_heats_r(t_l, cp_il)
728# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
729 call get_species_specific_heats_r(t_r, cp_ir)
730# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
731
732# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
733 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
734# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
735 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
736# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
737 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
738# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
739 if (abs(t_l - t_r) < eps) then
740# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
741 ! Case when T_L and T_R are very close
742# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
743 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
744# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
745 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
746# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
747 & - gas_constant/molecular_weights(:)))
748# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
749 else
750# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
751 ! Normal calculation when T_L and T_R are sufficiently different
752# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
753 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
754# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
755 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
756# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
757 end if
758# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
759 gamma_avg = cp_avg/cv_avg
760# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
761
762# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
763 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
764# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
765 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
766# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
767 end if
768# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
769 end if
770# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
771
772# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
773 if (avg_state == avg_state_arithmetic) then
774# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
775 rho_avg = 5.e-1_wp*(rho_l + rho_r)
776# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
777 vel_avg_rms = 0._wp
778# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
779
780# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
781#if defined(MFC_OpenACC)
782# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
783!$acc loop seq
784# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
785#elif defined(MFC_OpenMP)
786# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
787
788# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
789#endif
790# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
791 do i = 1, num_vels
792# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
793 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
794# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
795 end do
796# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
797
798# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
799 h_avg = 5.e-1_wp*(h_l + h_r)
800# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
801 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
802# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
803 qv_avg = 5.e-1_wp*(qv_l + qv_r)
804# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
805 end if
806
807 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
808 & c_l, qv_l)
809
810 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
811 & c_r, qv_r)
812
813 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
814 ! variables are placeholders to call the subroutine.
815 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
816 & 0._wp, c_avg, qv_avg)
817
818 if (viscous) then
819
820# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
821#if defined(MFC_OpenACC)
822# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
823!$acc loop seq
824# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
825#elif defined(MFC_OpenMP)
826# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
827
828# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
829#endif
830 do i = 1, 2
831 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
832 end do
833 end if
834
835 ! Low Mach correction
836 if (low_mach == 2) then
837 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
838# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
839 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
840# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
841 pcorr = 0._wp
842# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
843
844# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
845 if (low_mach == 1) then
846# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
847 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
848# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
849 end if
850# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
851 else if (riemann_solver == riemann_solver_hllc) then
852# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
853 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
854# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
855 pcorr = 0._wp
856# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
857
858# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
859 if (low_mach == 1) then
860# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
861 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
862# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
863 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
864# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
865 else if (low_mach == 2) then
866# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
867 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
868# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
869 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
870# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
871 vel_l(dir_idx(1)) = vel_l_tmp
872# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
873 vel_r(dir_idx(1)) = vel_r_tmp
874# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
875 end if
876# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
877 end if
878 end if
879
880 ! COMPUTING THE DIRECT WAVE SPEEDS
881 if (wave_speeds == wave_speeds_direct) then
882 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
883 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
884 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
885 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
886 & - rho_r*(s_r - vel_r(dir_idx(1))))
887 else if (wave_speeds == wave_speeds_pressure) then
888 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
889
890 pres_sr = pres_sl
891
892 ! Low Mach correction: Thornber et al. JCP (2008)
893 ms_l = max(1._wp, &
894 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
895 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
896 ms_r = max(1._wp, &
897 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
898 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
899
900 s_l = vel_l(dir_idx(1)) - c_l*ms_l
901 s_r = vel_r(dir_idx(1)) + c_r*ms_r
902
903 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
904 end if
905
906 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
907 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
908
909 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
910 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
911 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
912 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
913 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
914
915 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
916 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
917 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
918
919 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
920 xi_mp = -min(0._wp, sign(1._wp, s_l))
921 xi_pp = max(0._wp, sign(1._wp, s_r))
922
923 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 &
924 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
925 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
926 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
927 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
928
929 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))
930
931 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 &
932 & - vel_r(dir_idx(1)))
933
934 ! Low Mach correction
935 if (low_mach == 1) then
936 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
937# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
938 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
939# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
940 pcorr = 0._wp
941# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
942
943# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
944 if (low_mach == 1) then
945# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
946 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
947# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
948 end if
949# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
950 else if (riemann_solver == riemann_solver_hllc) then
951# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
952 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
953# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
954 pcorr = 0._wp
955# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
956
957# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
958 if (low_mach == 1) then
959# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
960 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
961# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
962 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
963# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
964 else if (low_mach == 2) then
965# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
966 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
967# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
968 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
969# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
970 vel_l(dir_idx(1)) = vel_l_tmp
971# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
972 vel_r(dir_idx(1)) = vel_r_tmp
973# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
974 end if
975# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
976 end if
977 else
978 pcorr = 0._wp
979 end if
980
981 ! COMPUTING FLUXES MASS FLUX.
982
983# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
984#if defined(MFC_OpenACC)
985# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
986!$acc loop seq
987# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
988#elif defined(MFC_OpenMP)
989# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
990
991# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
992#endif
993 do i = 1, eqn_idx%cont%end
994 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
995 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
996 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
997 end do
998
999 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1000
1001# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1002#if defined(MFC_OpenACC)
1003# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1004!$acc loop seq
1005# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1006#elif defined(MFC_OpenMP)
1007# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1008
1009# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1010#endif
1011 do i = 1, num_dims
1012 flux_rsx_vf(j, k, l, &
1013 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
1014 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
1015 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
1016 & *dir_flg(dir_idx(i))*pcorr
1017 end do
1018
1019 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
1020 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
1021
1022 ! VOLUME FRACTION FLUX.
1023
1024# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1025#if defined(MFC_OpenACC)
1026# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1027!$acc loop seq
1028# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1029#elif defined(MFC_OpenMP)
1030# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1031
1032# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1033#endif
1034 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1035 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1036 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
1037 end do
1038
1039 ! Advection velocity source: interface velocity for volume fraction transport
1040
1041# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1042#if defined(MFC_OpenACC)
1043# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1044!$acc loop seq
1045# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1046#elif defined(MFC_OpenMP)
1047# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1048
1049# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1050#endif
1051 do i = 1, num_dims
1052 vel_src_rsx_vf(j, k, l, &
1053 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1054 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
1055 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
1056 end do
1057
1058 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
1059 ! energy flux
1060
1061# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1062#if defined(MFC_OpenACC)
1063# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1064!$acc loop seq
1065# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1066#elif defined(MFC_OpenMP)
1067# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1068
1069# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1070#endif
1071 do i = 1, num_fluids
1072 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
1073 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
1074 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
1075 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
1076 & + pres_r)
1077
1078 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
1079 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1080 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
1081 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
1082 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1083 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
1084 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
1085 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1086 & i + eqn_idx%adv%beg - 1))
1087 end do
1088
1089 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1090
1091 ! COLOR FUNCTION FLUX
1092 if (surface_tension) then
1093 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
1094 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
1095 end if
1096
1097 ! Geometrical source flux for cylindrical coordinates
1098# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1099# 463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1100 end do
1101 end do
1102 end do
1103
1104# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1105#if defined(MFC_OpenACC)
1106# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1107!$acc end parallel loop
1108# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1109#elif defined(MFC_OpenMP)
1110# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1111
1112# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1113!$omp end target teams loop
1114# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1115#endif
1116 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
1117 ! 5-equation model with Euler-Euler bubble dynamics
1118
1119# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1120
1121# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1122#if defined(MFC_OpenACC)
1123# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1124!$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, &
1125# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1126!$acc& gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, &
1127# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1128!$acc& vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, &
1129# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1130!$acc& PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) &
1131# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1132!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
1133# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1134#elif defined(MFC_OpenMP)
1135# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1136
1137# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1138
1139# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1140
1141# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1142!$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, &
1143# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1144!$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, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, &
1145# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1146!$omp& E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, &
1147# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1148!$omp& alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, &
1149# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1150!$omp& Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2)
1151# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1152#endif
1153# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1154 do l = is3%beg, is3%end
1155 do k = is2%beg, is2%end
1156 do j = is1%beg, is1%end
1157 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1158 rho_l = 0._wp; rho_r = 0._wp
1159 gamma_l = 0._wp; gamma_r = 0._wp
1160 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1161 qv_l = 0._wp; qv_r = 0._wp
1162
1163
1164# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1165#if defined(MFC_OpenACC)
1166# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1167!$acc loop seq
1168# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1169#elif defined(MFC_OpenMP)
1170# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1171
1172# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1173#endif
1174 do i = 1, num_fluids
1175 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1176 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1177 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1178 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1179 end do
1180
1181 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1182
1183
1184# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1185#if defined(MFC_OpenACC)
1186# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1187!$acc loop seq
1188# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1189#elif defined(MFC_OpenMP)
1190# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1191
1192# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1193#endif
1194 do i = 1, num_dims
1195 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1196 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1197 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1198 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1199 end do
1200
1201 ! Retain this in the refactor
1202 if (mpp_lim .and. (num_fluids > 2)) then
1203 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, &
1204 & pi_inf_l, qv_l)
1205 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, &
1206 & pi_inf_r, qv_r)
1207 else if (num_fluids > 2) then
1208 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_l, alpha_l, rho_l, gamma_l, &
1209 & pi_inf_l, qv_l)
1210 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_r, alpha_r, rho_r, gamma_r, &
1211 & pi_inf_r, qv_r)
1212 else
1213 rho_l = ql_prim_rsx_vf(j, k, l, 1)
1214 gamma_l = gammas(1)
1215 pi_inf_l = pi_infs(1)
1216 qv_l = qvs(1)
1217 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
1218 gamma_r = gammas(1)
1219 pi_inf_r = pi_infs(1)
1220 qv_r = qvs(1)
1221 end if
1222
1223 if (viscous) then
1224 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
1225
1226# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1227#if defined(MFC_OpenACC)
1228# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1229!$acc loop seq
1230# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1231#elif defined(MFC_OpenMP)
1232# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1233
1234# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1235#endif
1236 do i = 1, 2
1237 re_l(i) = dflt_real
1238 re_r(i) = dflt_real
1239
1240 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
1241 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
1242
1243
1244# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1245#if defined(MFC_OpenACC)
1246# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1247!$acc loop seq
1248# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1249#elif defined(MFC_OpenMP)
1250# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1251
1252# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1253#endif
1254 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
1255 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
1256 & q)))/res_gs(i, q) + re_l(i)
1257 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
1258 & q)))/res_gs(i, q) + re_r(i)
1259 end do
1260
1261 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1262 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1263 end do
1264 end if
1265 end if
1266
1267 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1268 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1269
1270 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
1271 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
1272
1273 h_l = (e_l + pres_l)/rho_l
1274 h_r = (e_r + pres_r)/rho_r
1275
1276 if (avg_state == avg_state_arithmetic) then
1277
1278# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1279#if defined(MFC_OpenACC)
1280# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1281!$acc loop seq
1282# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1283#elif defined(MFC_OpenMP)
1284# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1285
1286# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1287#endif
1288 do i = 1, nb
1289 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
1290 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
1291
1292 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
1293 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
1294 if (.not. polytropic .and. .not. qbmm) then
1295 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
1296 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
1297 end if
1298 end do
1299
1300 if (.not. qbmm) then
1301 if (adv_n) then
1302 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
1303 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
1304 else
1305 nbub_l = 0._wp
1306 nbub_r = 0._wp
1307
1308# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1309#if defined(MFC_OpenACC)
1310# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1311!$acc loop seq
1312# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1313#elif defined(MFC_OpenMP)
1314# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1315
1316# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1317#endif
1318 do i = 1, nb
1319 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
1320 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
1321 end do
1322
1323 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
1324 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
1325 & eqn_idx%E + num_fluids)/nbub_r
1326 end if
1327 else
1328 ! nb stored in 0th moment of first R0 bin in variable conversion module
1329 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
1330 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
1331 end if
1332
1333
1334# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1335#if defined(MFC_OpenACC)
1336# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1337!$acc loop seq
1338# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1339#elif defined(MFC_OpenMP)
1340# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1341
1342# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1343#endif
1344 do i = 1, nb
1345 if (.not. qbmm) then
1346 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
1347 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
1348 end if
1349 end do
1350
1351 if (qbmm) then
1352 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
1353 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
1354
1355 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
1356 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
1357
1358 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
1359 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
1360 else
1361 pbwr3lbar = 0._wp
1362 pbwr3rbar = 0._wp
1363
1364 r3lbar = 0._wp
1365 r3rbar = 0._wp
1366
1367 r3v2lbar = 0._wp
1368 r3v2rbar = 0._wp
1369
1370
1371# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1372#if defined(MFC_OpenACC)
1373# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1374!$acc loop seq
1375# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1376#elif defined(MFC_OpenMP)
1377# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1378
1379# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1380#endif
1381 do i = 1, nb
1382 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
1383 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
1384
1385 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
1386 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
1387
1388 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
1389 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
1390 end do
1391 end if
1392
1393 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1394 h_avg = 5.e-1_wp*(h_l + h_r)
1395 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1396 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1397 vel_avg_rms = 0._wp
1398
1399
1400# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1401#if defined(MFC_OpenACC)
1402# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1403!$acc loop seq
1404# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1405#elif defined(MFC_OpenMP)
1406# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1407
1408# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1409#endif
1410 do i = 1, num_dims
1411 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1412 end do
1413 end if
1414
1415 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
1416 & c_l, qv_l)
1417
1418 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
1419 & c_r, qv_r)
1420
1421 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1422 ! variables are placeholders to call the subroutine.
1423 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1424 & 0._wp, c_avg, qv_avg)
1425
1426 if (viscous) then
1427
1428# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1429#if defined(MFC_OpenACC)
1430# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1431!$acc loop seq
1432# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1433#elif defined(MFC_OpenMP)
1434# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1435
1436# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1437#endif
1438 do i = 1, 2
1439 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1440 end do
1441 end if
1442
1443 ! Low Mach correction
1444 if (low_mach == 2) then
1445 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
1446# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1447 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1448# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1449 pcorr = 0._wp
1450# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1451
1452# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1453 if (low_mach == 1) then
1454# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1455 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1456# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1457 end if
1458# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1459 else if (riemann_solver == riemann_solver_hllc) then
1460# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1461 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1462# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1463 pcorr = 0._wp
1464# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1465
1466# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1467 if (low_mach == 1) then
1468# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1469 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
1470# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1471 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1472# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1473 else if (low_mach == 2) then
1474# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1475 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1476# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1477 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
1478# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1479 vel_l(dir_idx(1)) = vel_l_tmp
1480# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1481 vel_r(dir_idx(1)) = vel_r_tmp
1482# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1483 end if
1484# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1485 end if
1486 end if
1487
1488 if (wave_speeds == wave_speeds_direct) then
1489 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1490 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1491
1492 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1493 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1494 & - rho_r*(s_r - vel_r(dir_idx(1))))
1495 else if (wave_speeds == wave_speeds_pressure) then
1496 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1497
1498 pres_sr = pres_sl
1499
1500 ! Low Mach correction: Thornber et al. JCP (2008)
1501 ms_l = max(1._wp, &
1502 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1503 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1504 ms_r = max(1._wp, &
1505 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1506 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1507
1508 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1509 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1510
1511 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1512 end if
1513
1514 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1515 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1516
1517 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1518 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1519 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1520 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1521 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1522
1523 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1524 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1525 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1526
1527 ! Low Mach correction
1528 if (low_mach == 1) then
1529 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
1530# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1531 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1532# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1533 pcorr = 0._wp
1534# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1535
1536# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1537 if (low_mach == 1) then
1538# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1539 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1540# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1541 end if
1542# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1543 else if (riemann_solver == riemann_solver_hllc) then
1544# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1545 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1546# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1547 pcorr = 0._wp
1548# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1549
1550# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1551 if (low_mach == 1) then
1552# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1553 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
1554# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1555 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1556# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1557 else if (low_mach == 2) then
1558# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1559 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1560# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1561 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
1562# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1563 vel_l(dir_idx(1)) = vel_l_tmp
1564# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1565 vel_r(dir_idx(1)) = vel_r_tmp
1566# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1567 end if
1568# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1569 end if
1570 else
1571 pcorr = 0._wp
1572 end if
1573
1574
1575# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1576#if defined(MFC_OpenACC)
1577# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1578!$acc loop seq
1579# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1580#elif defined(MFC_OpenMP)
1581# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1582
1583# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1584#endif
1585 do i = 1, eqn_idx%cont%end
1586 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1587 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1588 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1589 end do
1590
1591 if (bubbles_euler .and. (num_fluids > 1)) then
1592 ! Kill mass transport @ gas density
1593 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
1594 end if
1595
1596 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1597
1598 ! Include p_tilde
1599
1600 if (avg_state == avg_state_arithmetic) then
1601 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
1602 pres_l = pres_l - alpha_l(num_fluids)*pres_l
1603 else
1604 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
1605 end if
1606
1607 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
1608 pres_r = pres_r - alpha_r(num_fluids)*pres_r
1609 else
1610 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
1611 end if
1612 end if
1613
1614
1615# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1616#if defined(MFC_OpenACC)
1617# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1618!$acc loop seq
1619# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1620#elif defined(MFC_OpenMP)
1621# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1622
1623# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1624#endif
1625 do i = 1, num_dims
1626 flux_rsx_vf(j, k, l, &
1627 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
1628 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1629 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
1630 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1631 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1632 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
1633 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
1634 end do
1635
1636 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
1637 flux_rsx_vf(j, k, l, &
1638 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
1639 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
1640 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
1641 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
1642 & *pcorr*s_s
1643
1644 ! Volume fraction flux
1645
1646# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1647#if defined(MFC_OpenACC)
1648# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1649!$acc loop seq
1650# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1651#elif defined(MFC_OpenMP)
1652# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1653
1654# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1655#endif
1656 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1657 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1658 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1659 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1660 end do
1661
1662 ! Advection velocity source: interface velocity for volume fraction transport
1663
1664# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1665#if defined(MFC_OpenACC)
1666# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1667!$acc loop seq
1668# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1669#elif defined(MFC_OpenMP)
1670# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1671
1672# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1673#endif
1674 do i = 1, num_dims
1675 vel_src_rsx_vf(j, k, l, &
1676 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
1677 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
1678 end do
1679
1680 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1681
1682 ! Add advection flux for bubble variables
1683
1684# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1685#if defined(MFC_OpenACC)
1686# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1687!$acc loop seq
1688# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1689#elif defined(MFC_OpenMP)
1690# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1691
1692# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1693#endif
1694 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1695 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
1696 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1697 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1698 end do
1699
1700 if (qbmm) then
1701 flux_rsx_vf(j, k, l, &
1702 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1703 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1704 end if
1705
1706 if (adv_n) then
1707 flux_rsx_vf(j, k, l, &
1708 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1709 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1710 end if
1711
1712 ! Geometrical source flux for cylindrical coordinates
1713# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1714# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1715 end do
1716 end do
1717 end do
1718
1719# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1720#if defined(MFC_OpenACC)
1721# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1722!$acc end parallel loop
1723# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1724#elif defined(MFC_OpenMP)
1725# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1726
1727# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1728!$omp end target teams loop
1729# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1730#endif
1731# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1732# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1733 else if (hypoelasticity) then
1734# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1735 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
1736 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
1737 ! statement and private variable from the pure-fluid emission, keeping its body and directive
1738 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
1739 ! pinned it at the GPU register ceiling for every HLLC user.
1740# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1741 ! Private list split across _hllc_p1/p2/p3 for Fypp line-length limits
1742# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1743# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1744# 861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1745# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1746# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1747 ! The two calls below are identical on purpose. An offload kernel is named
1748 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
1749 ! both emissions the same name; amdflang then launches the wrong one and a
1750 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
1751 ! give two line numbers. Do not merge them back into one.
1752# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1753
1754# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1755
1756# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1757#if defined(MFC_OpenACC)
1758# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1759!$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, &
1760# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1761!$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, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, &
1762# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1763!$acc& gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, &
1764# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1765!$acc& alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, ptilde_L, ptilde_R, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, Yi_avg, &
1766# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1767!$acc& Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R, damage_L, damage_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, &
1768# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1769!$acc& 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, 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, &
1770# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1771!$acc& 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, u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, &
1772# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1773!$acc& dSigma, Sigma_ref, a_L_ref, a_R_ref, 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) &
1774# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1775!$acc& copyin(is1, is2, is3)
1776# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1777#elif defined(MFC_OpenMP)
1778# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1779
1780# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1781
1782# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1783
1784# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1785!$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, &
1786# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1787!$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, &
1788# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1789!$omp& Cv_L, Cv_R, Cp_avg, Cv_avg, T_avg, eps, 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, &
1790# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1791!$omp& 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, vel_avg_rms, pcorr, zcoef, ptilde_L, ptilde_R, &
1792# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1793!$omp& vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R, damage_L, damage_R, U_L, U_R, F_L, F_R, &
1794# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1795!$omp& 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, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, &
1796# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1797!$omp& 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, u_t2_star, tau_nt2_star, pres_tot_star, &
1798# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1799!$omp& 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, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, &
1800# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1801!$omp& sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
1802# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1803#endif
1804# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1805# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1806 do l = is3%beg, is3%end
1807 do k = is2%beg, is2%end
1808 do j = is1%beg, is1%end
1809 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1810 rho_l = 0._wp; rho_r = 0._wp
1811 gamma_l = 0._wp; gamma_r = 0._wp
1812 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1813 qv_l = 0._wp; qv_r = 0._wp
1814 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
1815
1816
1817# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1818#if defined(MFC_OpenACC)
1819# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1820!$acc loop seq
1821# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1822#elif defined(MFC_OpenMP)
1823# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1824
1825# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1826#endif
1827 do i = 1, num_fluids
1828 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1829 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1830 end do
1831
1832
1833# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1834#if defined(MFC_OpenACC)
1835# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1836!$acc loop seq
1837# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1838#elif defined(MFC_OpenMP)
1839# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1840
1841# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1842#endif
1843 do i = 1, num_dims
1844 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1845 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1846 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1847 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1848 end do
1849
1850 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1851 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1852
1853# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1854
1855# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1856#if defined(MFC_OpenACC)
1857# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1858!$acc loop seq
1859# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1860#elif defined(MFC_OpenMP)
1861# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1862
1863# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1864#endif
1865 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1866 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1867 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
1868 end do
1869
1870 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
1871 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
1872 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
1873 if (n > 0) then
1874 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
1875 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
1876 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
1877 end if
1878 if (p > 0) then
1879 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
1880 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
1881 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
1882 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
1883 end if
1884 pres_tot_l = pres_l - tau_nn_l
1885 pres_tot_r = pres_r - tau_nn_r
1886 if (cyl_coord) then
1887 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1888 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1889 else
1890 tau_qq_l = 0._wp
1891 tau_qq_r = 0._wp
1892 end if
1893# 936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1894
1895 ! Change this by splitting it into the cases present in the bubbles_euler
1896 if (mpp_lim) then
1897
1898# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1899#if defined(MFC_OpenACC)
1900# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1901!$acc loop seq
1902# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1903#elif defined(MFC_OpenMP)
1904# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1905
1906# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1907#endif
1908 do i = 1, num_fluids
1909 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
1910 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
1911 & eqn_idx%E + i)), 1._wp)
1912 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
1913 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
1914 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
1915 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1916 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1917 end do
1918
1919
1920# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1921#if defined(MFC_OpenACC)
1922# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1923!$acc loop seq
1924# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1925#elif defined(MFC_OpenMP)
1926# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1927
1928# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1929#endif
1930 do i = 1, num_fluids
1931 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
1932 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
1933 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
1934 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
1935 end do
1936 end if
1937
1938 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
1939 ! downstream
1940
1941# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1942#if defined(MFC_OpenACC)
1943# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1944!$acc loop seq
1945# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1946#elif defined(MFC_OpenMP)
1947# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1948
1949# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1950#endif
1951 do i = 1, num_fluids
1952 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1953 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1954 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1955 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1956 end do
1957
1958 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
1959 & pi_inf_l, qv_l)
1960 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
1961 & pi_inf_r, qv_r)
1962
1963 if (viscous) then
1964 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
1965 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
1966 end if
1967
1968 if (chemistry) then
1969 c_sum_yi_phi = 0.0_wp
1970
1971# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1972#if defined(MFC_OpenACC)
1973# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1974!$acc loop seq
1975# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1976#elif defined(MFC_OpenMP)
1977# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1978
1979# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1980#endif
1981 do i = eqn_idx%species%beg, eqn_idx%species%end
1982 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
1983 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
1984 end do
1985
1986 call get_mixture_molecular_weight(ys_l, mw_l)
1987 call get_mixture_molecular_weight(ys_r, mw_r)
1988
1989 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1990 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1991
1992 r_gas_l = gas_constant/mw_l
1993 r_gas_r = gas_constant/mw_r
1994
1995 t_l = pres_l/rho_l/r_gas_l
1996 t_r = pres_r/rho_r/r_gas_r
1997
1998 call get_species_specific_heats_r(t_l, cp_il)
1999 call get_species_specific_heats_r(t_r, cp_ir)
2000
2001 if (chem_params%gamma_method == 1) then
2002 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2003 gamma_il = cp_il/(cp_il - 1.0_wp)
2004 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2005
2006 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2007 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2008 else if (chem_params%gamma_method == 2) then
2009 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2010 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2011 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2012 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2013 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2014
2015 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
2016 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2017 end if
2018
2019 call get_mixture_energy_mass(t_l, ys_l, e_l)
2020 call get_mixture_energy_mass(t_r, ys_r, e_r)
2021
2022 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2023 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2024 h_l = (e_l + pres_l)/rho_l
2025 h_r = (e_r + pres_r)/rho_r
2026 else
2027 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2028 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2029
2030 h_l = (e_l + pres_l)/rho_l
2031 h_r = (e_r + pres_r)/rho_r
2032 end if
2033
2034# 1037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2035 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
2036
2037# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2038#if defined(MFC_OpenACC)
2039# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2040!$acc loop seq
2041# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2042#elif defined(MFC_OpenMP)
2043# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2044
2045# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2046#endif
2047 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2048 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2049 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2050 end do
2051 damage_l = 0._wp; damage_r = 0._wp
2052 if (cont_damage) then
2053 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
2054 damage_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%damage)
2055 end if
2056
2057 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
2058 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
2059 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
2060 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
2061 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
2062 ! keep their pre-adjustment values here.
2063# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2064
2065 if (avg_state == avg_state_roe) then
2066# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2067 rho_avg = sqrt(rho_l*rho_r)
2068# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2069
2070# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2071 vel_avg_rms = 0._wp
2072# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2073
2074# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2075
2076# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2077#if defined(MFC_OpenACC)
2078# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2079!$acc loop seq
2080# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2081#elif defined(MFC_OpenMP)
2082# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2083
2084# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2085#endif
2086# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2087 do i = 1, num_vels
2088# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2089 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
2090# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2091 end do
2092# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2093
2094# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2095 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
2096# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2097
2098# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2099 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
2100# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2101
2102# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2103 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
2104# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2105
2106# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2107 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
2108# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2109
2110# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2111 if (chemistry) then
2112# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2113 eps = 0.001_wp
2114# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2115 call get_species_enthalpies_rt(t_l, h_il)
2116# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2117 call get_species_enthalpies_rt(t_r, h_ir)
2118# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2119 h_il = h_il*gas_constant/molecular_weights*t_l
2120# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2121 h_ir = h_ir*gas_constant/molecular_weights*t_r
2122# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2123 call get_species_specific_heats_r(t_l, cp_il)
2124# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2125 call get_species_specific_heats_r(t_r, cp_ir)
2126# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2127
2128# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2129 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2130# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2131 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2132# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2133 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2134# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2135 if (abs(t_l - t_r) < eps) then
2136# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2137 ! Case when T_L and T_R are very close
2138# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2139 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2140# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2141 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2142# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2143 & - gas_constant/molecular_weights(:)))
2144# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2145 else
2146# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2147 ! Normal calculation when T_L and T_R are sufficiently different
2148# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2149 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2150# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2151 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2152# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2153 end if
2154# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2155 gamma_avg = cp_avg/cv_avg
2156# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2157
2158# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2159 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2160# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2161 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2162# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2163 end if
2164# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2165 end if
2166# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2167
2168# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2169 if (avg_state == avg_state_arithmetic) then
2170# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2171 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2172# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2173 vel_avg_rms = 0._wp
2174# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2175
2176# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2177#if defined(MFC_OpenACC)
2178# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2179!$acc loop seq
2180# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2181#elif defined(MFC_OpenMP)
2182# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2183
2184# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2185#endif
2186# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2187 do i = 1, num_vels
2188# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2189 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2190# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2191 end do
2192# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2193
2194# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2195 h_avg = 5.e-1_wp*(h_l + h_r)
2196# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2197 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2198# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2199 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2200# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2201 end if
2202
2203 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, &
2204 & 0._wp, c_l, qv_l)
2205
2206 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, &
2207 & 0._wp, c_r, qv_r)
2208
2209 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2210 ! variables are placeholders to call the subroutine.
2211 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
2212 & vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
2213
2214 if (viscous) then
2215 if (chemistry) then
2216 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2217 end if
2218
2219# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2220#if defined(MFC_OpenACC)
2221# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2222!$acc loop seq
2223# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2224#elif defined(MFC_OpenMP)
2225# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2226
2227# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2228#endif
2229 do i = 1, 2
2230 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2231 end do
2232 end if
2233
2234 ! Low Mach correction
2235 if (low_mach == 2) then
2236 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2237# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2238 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2239# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2240 pcorr = 0._wp
2241# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2242
2243# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2244 if (low_mach == 1) then
2245# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2246 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2247# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2248 end if
2249# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2250 else if (riemann_solver == riemann_solver_hllc) then
2251# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2252 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2253# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2254 pcorr = 0._wp
2255# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2256
2257# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2258 if (low_mach == 1) then
2259# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2260 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
2261# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2262 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2263# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2264 else if (low_mach == 2) then
2265# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2266 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2267# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2268 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
2269# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2270 vel_l(dir_idx(1)) = vel_l_tmp
2271# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2272 vel_r(dir_idx(1)) = vel_r_tmp
2273# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2274 end if
2275# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2276 end if
2277 end if
2278
2279 if (wave_speeds == wave_speeds_direct) then
2280# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2281 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2282 s_l = min(vel_l(dir_idx(1)) - sqrt(max(verysmall, c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l)), &
2283# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2284 & vel_r(dir_idx(1)) - sqrt(max(verysmall, c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r)))
2285# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2286 s_r = max(vel_r(dir_idx(1)) + sqrt(max(verysmall, c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r)), &
2287# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2288 & vel_l(dir_idx(1)) + sqrt(max(verysmall, c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l)))
2289 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
2290 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
2291 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
2292 & - vel_r(dir_idx(1))))
2293# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2294 else if (wave_speeds == wave_speeds_pressure) then
2295 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2296
2297 pres_sr = pres_sl
2298
2299 ! Low Mach correction: Thornber et al. JCP (2008)
2300 ms_l = max(1._wp, &
2301 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l &
2302 & - 1._wp)*pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2303 ms_r = max(1._wp, &
2304 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r &
2305 & - 1._wp)*pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2306
2307 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2308 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2309
2310 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2311 end if
2312
2313 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2314 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2315
2316 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2317 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2318 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2319 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
2320 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2321 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2322
2323 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2324 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2325 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2326
2327 ! Low Mach correction
2328 if (low_mach == 1) then
2329 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2330# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2331 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2332# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2333 pcorr = 0._wp
2334# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2335
2336# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2337 if (low_mach == 1) then
2338# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2339 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2340# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2341 end if
2342# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2343 else if (riemann_solver == riemann_solver_hllc) then
2344# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2345 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2346# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2347 pcorr = 0._wp
2348# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2349
2350# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2351 if (low_mach == 1) then
2352# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2353 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
2354# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2355 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2356# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2357 else if (low_mach == 2) then
2358# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2359 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2360# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2361 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
2362# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2363 vel_l(dir_idx(1)) = vel_l_tmp
2364# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2365 vel_r(dir_idx(1)) = vel_r_tmp
2366# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2367 end if
2368# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2369 end if
2370 else
2371 pcorr = 0._wp
2372 end if
2373
2374# 1144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2375 if (n == 0) then
2376 u_t_l = 0._wp; u_t_r = 0._wp
2377 tau_nt_l = 0._wp; tau_nt_r = 0._wp
2378 end if
2379 if (p == 0) then
2380 u_t2_l = 0._wp; u_t2_r = 0._wp
2381 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
2382 end if
2383 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
2384 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
2385 denom_a = a_r - a_l
2386 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
2387 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
2388 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
2389 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
2390 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
2391# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2392
2393 ! COMPUTING THE HLLC FLUXES MASS FLUX.
2394
2395# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2396#if defined(MFC_OpenACC)
2397# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2398!$acc loop seq
2399# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2400#elif defined(MFC_OpenMP)
2401# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2402
2403# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2404#endif
2405 do i = 1, eqn_idx%cont%end
2406 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2407 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2408 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2409 end do
2410
2411# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2412 flux_rsx_vf(j, k, l, &
2413 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
2414 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
2415 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
2416 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
2417 if (n > 0) then
2418 flux_rsx_vf(j, k, l, &
2419 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
2420 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
2421 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
2422 & - tau_nt_r)
2423 end if
2424 if (p > 0) then
2425 flux_rsx_vf(j, k, l, &
2426 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
2427 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
2428 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
2429 & - tau_nt2_r)
2430 end if
2431
2432 flux_rsx_vf(j, k, l, &
2433 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
2434 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
2435 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
2436 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
2437 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
2438 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
2439 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
2440 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
2441 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
2442 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
2443
2444 if (n == 0) then
2445 flux_rsx_vf(j, k, l, &
2446 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
2447 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
2448 & + s_p*(xi_r - 1._wp))
2449 else if (p == 0) then
2450 if (dir_idx(1) == 1) then
2451 flux_rsx_vf(j, k, l, &
2452 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
2453 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
2454 & + s_p*(xi_r - 1._wp))
2455 flux_rsx_vf(j, k, l, &
2456 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
2457 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
2458 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
2459 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
2460 flux_rsx_vf(j, k, l, &
2461 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
2462 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
2463 & + s_p*(xi_r - 1._wp))
2464 else
2465 flux_rsx_vf(j, k, l, &
2466 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
2467 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
2468 & + s_p*(xi_r - 1._wp))
2469 flux_rsx_vf(j, k, l, &
2470 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
2471 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
2472 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
2473 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
2474 flux_rsx_vf(j, k, l, &
2475 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
2476 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
2477 & + s_p*(xi_r - 1._wp))
2478 end if
2479 else
2480 flux_rsx_vf(j, k, l, &
2481 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
2482 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2483 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2484 flux_rsx_vf(j, k, l, &
2485 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
2486 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
2487 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
2488 & - rho_r*tau_nt_r))
2489 flux_rsx_vf(j, k, l, &
2490 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
2491 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
2492 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
2493 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
2494 flux_rsx_vf(j, k, l, &
2495 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
2496 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2497 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2498 flux_rsx_vf(j, k, l, &
2499 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
2500 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2501 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2502 flux_rsx_vf(j, k, l, &
2503 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
2504 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
2505 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
2506 end if
2507 if (cyl_coord) then
2508 flux_rsx_vf(j, k, l, &
2509 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
2510 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
2511 & + s_p*(xi_r - 1._wp))
2512 end if
2513
2514 if (s_l >= 0._wp) then
2515 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
2516 else if (s_r <= 0._wp) then
2517 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
2518 else
2519 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
2520 end if
2521 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2522 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2523 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2524# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2525
2526 ! VOLUME FRACTION FLUX.
2527
2528# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2529#if defined(MFC_OpenACC)
2530# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2531!$acc loop seq
2532# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2533#elif defined(MFC_OpenMP)
2534# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2535
2536# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2537#endif
2538 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2539 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2540 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2541 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2542 end do
2543
2544 ! VOLUME FRACTION SOURCE FLUX.
2545
2546# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2547#if defined(MFC_OpenACC)
2548# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2549!$acc loop seq
2550# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2551#elif defined(MFC_OpenMP)
2552# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2553
2554# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2555#endif
2556 do i = 1, num_dims
2557 vel_src_rsx_vf(j, k, l, &
2558 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2559 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2560 end do
2561
2562 ! COLOR FUNCTION FLUX
2563 if (surface_tension) then
2564 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
2565 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2566 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2567 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2568 end if
2569
2570 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2571
2572 if (chemistry) then
2573
2574# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2575#if defined(MFC_OpenACC)
2576# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2577!$acc loop seq
2578# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2579#elif defined(MFC_OpenMP)
2580# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2581
2582# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2583#endif
2584 do i = eqn_idx%species%beg, eqn_idx%species%end
2585 y_l = ql_prim_rsx_vf(j, k, l, i)
2586 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
2587
2588 flux_rsx_vf(j, k, l, &
2589 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2590 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2591 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
2592 end do
2593 end if
2594
2595# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2596 ! HLLC-ADC blending for hypoelasticity
2597 if (riemann_hypo_adc) then
2598 ! Build U_L, U_R and F_L, F_R in local-basis layout
2599
2600# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2601#if defined(MFC_OpenACC)
2602# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2603!$acc loop seq
2604# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2605#elif defined(MFC_OpenMP)
2606# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2607
2608# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2609#endif
2610 do i = 1, num_fluids
2611 u_l(i) = alpha_rho_l(i)
2612 u_r(i) = alpha_rho_r(i)
2613 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
2614 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
2615 f_l(i) = alpha_rho_l(i)*u_n_l
2616 f_r(i) = alpha_rho_r(i)*u_n_r
2617 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
2618 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
2619 end do
2620
2621 ! Momentum U/F in physical order via dir_idx
2622 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
2623 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
2624 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
2625 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
2626 if (n > 0) then
2627 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
2628 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
2629 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
2630 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
2631 end if
2632 if (p > 0) then
2633 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
2634 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
2635 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
2636 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
2637 end if
2638
2639 u_l(eqn_idx%E) = e_l
2640 u_r(eqn_idx%E) = e_r
2641 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
2642 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
2643
2644 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
2645
2646# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2647#if defined(MFC_OpenACC)
2648# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2649!$acc loop seq
2650# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2651#elif defined(MFC_OpenMP)
2652# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2653
2654# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2655#endif
2656 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
2657 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
2658 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
2659 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
2660 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
2661 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
2662 end do
2663 if (cyl_coord) then
2664 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
2665 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
2666 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
2667 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
2668 end if
2669
2670 ! Compute F_HLL (physical order) and HLL trace velocities
2671 if (s_l >= 0._wp) then
2672
2673# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2674#if defined(MFC_OpenACC)
2675# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2676!$acc loop seq
2677# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2678#elif defined(MFC_OpenMP)
2679# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2680
2681# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2682#endif
2683 do i = 1, sys_size
2684 f_hll(i) = f_l(i)
2685 end do
2686 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
2687 else if (s_r <= 0._wp) then
2688
2689# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2690#if defined(MFC_OpenACC)
2691# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2692!$acc loop seq
2693# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2694#elif defined(MFC_OpenMP)
2695# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2696
2697# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2698#endif
2699 do i = 1, sys_size
2700 f_hll(i) = f_r(i)
2701 end do
2702 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
2703 else
2704
2705# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2706#if defined(MFC_OpenACC)
2707# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2708!$acc loop seq
2709# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2710#elif defined(MFC_OpenMP)
2711# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2712
2713# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2714#endif
2715 do i = 1, sys_size
2716 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 &
2717 & + verysmall)
2718 end do
2719 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
2720 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
2721 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
2722 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
2723 end if
2724
2725 ! ADC sensor
2726 sigma_l = pres_tot_l
2727 sigma_r = pres_tot_r
2728 dsigma = sigma_r - sigma_l
2729 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
2730
2731 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
2732 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
2733 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
2734
2735 du_t = u_t_r - u_t_l
2736 dtau_nt = tau_nt_r - tau_nt_l
2737 du_t2 = u_t2_r - u_t2_l
2738 dtau_nt2 = tau_nt2_r - tau_nt2_l
2739
2740 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
2741 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
2742 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
2743 & + verysmall)
2744
2745 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
2746 phi = exp(-(sensor_combined**adc_power))
2747
2748 ! Blend all flux components: F_HLL is in physical order
2749
2750# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2751#if defined(MFC_OpenACC)
2752# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2753!$acc loop seq
2754# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2755#elif defined(MFC_OpenMP)
2756# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2757
2758# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2759#endif
2760 do i = 1, sys_size
2761 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
2762 end do
2763
2764 ! Blend interface velocities (scalar HLL traces)
2765 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
2766 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
2767 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
2768
2769 ! Overwrite vel_src with blended velocities
2770 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2771 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2772 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2773
2774 ! Update advection source flux with ADC-blended face-normal velocity
2775 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
2776
2777 ! Overwrite nc_iface_vel with blended velocities
2778 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
2779 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
2780 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
2781 end if
2782 ! END HLLC-ADC
2783# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2784
2785 ! Geometrical source flux for cylindrical coordinates
2786# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2787# 1538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2788 end do
2789 end do
2790 end do
2791
2792# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2793#if defined(MFC_OpenACC)
2794# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2795!$acc end parallel loop
2796# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2797#elif defined(MFC_OpenMP)
2798# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2799
2800# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2801!$omp end target teams loop
2802# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2803#endif
2804# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2805# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2806 else
2807# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2808 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
2809 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
2810 ! statement and private variable from the pure-fluid emission, keeping its body and directive
2811 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
2812 ! pinned it at the GPU register ceiling for every HLLC user.
2813# 863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2814 ! Master's pure-fluid private list, unchanged
2815# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2816# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2817 ! The two calls below are identical on purpose. An offload kernel is named
2818 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
2819 ! both emissions the same name; amdflang then launches the wrong one and a
2820 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
2821 ! give two line numbers. Do not merge them back into one.
2822# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2823
2824# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2825
2826# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2827#if defined(MFC_OpenACC)
2828# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2829!$acc parallel loop collapse(3) gang vector default(present) private(i, 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, &
2830# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2831!$acc& alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, &
2832# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2833!$acc& 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, vel_avg_rms, pcorr, zcoef, &
2834# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2835!$acc& vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
2836# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2837#elif defined(MFC_OpenMP)
2838# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2839
2840# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2841
2842# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2843
2844# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2845!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, T_L, T_R, &
2846# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2847!$omp& vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, &
2848# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2849!$omp& Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, &
2850# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2851!$omp& 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, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
2852# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2853!$omp& Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
2854# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2855#endif
2856# 877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2857# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2858 do l = is3%beg, is3%end
2859 do k = is2%beg, is2%end
2860 do j = is1%beg, is1%end
2861 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2862 rho_l = 0._wp; rho_r = 0._wp
2863 gamma_l = 0._wp; gamma_r = 0._wp
2864 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2865 qv_l = 0._wp; qv_r = 0._wp
2866 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2867
2868
2869# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2870#if defined(MFC_OpenACC)
2871# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2872!$acc loop seq
2873# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2874#elif defined(MFC_OpenMP)
2875# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2876
2877# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2878#endif
2879 do i = 1, num_fluids
2880 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2881 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2882 end do
2883
2884
2885# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2886#if defined(MFC_OpenACC)
2887# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2888!$acc loop seq
2889# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2890#elif defined(MFC_OpenMP)
2891# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2892
2893# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2894#endif
2895 do i = 1, num_dims
2896 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2897 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
2898 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2899 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2900 end do
2901
2902 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2903 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
2904
2905# 936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2906
2907 ! Change this by splitting it into the cases present in the bubbles_euler
2908 if (mpp_lim) then
2909
2910# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2911#if defined(MFC_OpenACC)
2912# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2913!$acc loop seq
2914# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2915#elif defined(MFC_OpenMP)
2916# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2917
2918# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2919#endif
2920 do i = 1, num_fluids
2921 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2922 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2923 & eqn_idx%E + i)), 1._wp)
2924 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
2925 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
2926 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
2927 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2928 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2929 end do
2930
2931
2932# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2933#if defined(MFC_OpenACC)
2934# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2935!$acc loop seq
2936# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2937#elif defined(MFC_OpenMP)
2938# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2939
2940# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2941#endif
2942 do i = 1, num_fluids
2943 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2944 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2945 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
2946 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2947 end do
2948 end if
2949
2950 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
2951 ! downstream
2952
2953# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2954#if defined(MFC_OpenACC)
2955# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2956!$acc loop seq
2957# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2958#elif defined(MFC_OpenMP)
2959# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2960
2961# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2962#endif
2963 do i = 1, num_fluids
2964 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2965 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
2966 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2967 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2968 end do
2969
2970 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
2971 & pi_inf_l, qv_l)
2972 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
2973 & pi_inf_r, qv_r)
2974
2975 if (viscous) then
2976 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
2977 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
2978 end if
2979
2980 if (chemistry) then
2981 c_sum_yi_phi = 0.0_wp
2982
2983# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2984#if defined(MFC_OpenACC)
2985# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2986!$acc loop seq
2987# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2988#elif defined(MFC_OpenMP)
2989# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2990
2991# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2992#endif
2993 do i = eqn_idx%species%beg, eqn_idx%species%end
2994 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2995 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
2996 end do
2997
2998 call get_mixture_molecular_weight(ys_l, mw_l)
2999 call get_mixture_molecular_weight(ys_r, mw_r)
3000
3001 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3002 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3003
3004 r_gas_l = gas_constant/mw_l
3005 r_gas_r = gas_constant/mw_r
3006
3007 t_l = pres_l/rho_l/r_gas_l
3008 t_r = pres_r/rho_r/r_gas_r
3009
3010 call get_species_specific_heats_r(t_l, cp_il)
3011 call get_species_specific_heats_r(t_r, cp_ir)
3012
3013 if (chem_params%gamma_method == 1) then
3014 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3015 gamma_il = cp_il/(cp_il - 1.0_wp)
3016 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3017
3018 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3019 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3020 else if (chem_params%gamma_method == 2) then
3021 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3022 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3023 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3024 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3025 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3026
3027 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
3028 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3029 end if
3030
3031 call get_mixture_energy_mass(t_l, ys_l, e_l)
3032 call get_mixture_energy_mass(t_r, ys_r, e_r)
3033
3034 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3035 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3036 h_l = (e_l + pres_l)/rho_l
3037 h_r = (e_r + pres_r)/rho_r
3038 else
3039 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
3040 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
3041
3042 h_l = (e_l + pres_l)/rho_l
3043 h_r = (e_r + pres_r)/rho_r
3044 end if
3045
3046# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3047 h_l = (e_l + pres_l)/rho_l
3048 h_r = (e_r + pres_r)/rho_r
3049# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3050
3051 if (avg_state == avg_state_roe) then
3052# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3053 rho_avg = sqrt(rho_l*rho_r)
3054# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3055
3056# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3057 vel_avg_rms = 0._wp
3058# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3059
3060# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3061
3062# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3063#if defined(MFC_OpenACC)
3064# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3065!$acc loop seq
3066# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3067#elif defined(MFC_OpenMP)
3068# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3069
3070# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3071#endif
3072# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3073 do i = 1, num_vels
3074# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3075 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
3076# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3077 end do
3078# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3079
3080# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3081 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3082# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3083
3084# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3085 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3086# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3087
3088# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3089 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
3090# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3091
3092# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3093 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3094# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3095
3096# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3097 if (chemistry) then
3098# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3099 eps = 0.001_wp
3100# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3101 call get_species_enthalpies_rt(t_l, h_il)
3102# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3103 call get_species_enthalpies_rt(t_r, h_ir)
3104# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3105 h_il = h_il*gas_constant/molecular_weights*t_l
3106# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3107 h_ir = h_ir*gas_constant/molecular_weights*t_r
3108# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3109 call get_species_specific_heats_r(t_l, cp_il)
3110# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3111 call get_species_specific_heats_r(t_r, cp_ir)
3112# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3113
3114# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3115 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3116# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3117 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3118# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3119 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3120# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3121 if (abs(t_l - t_r) < eps) then
3122# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3123 ! Case when T_L and T_R are very close
3124# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3125 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3126# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3127 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3128# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3129 & - gas_constant/molecular_weights(:)))
3130# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3131 else
3132# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3133 ! Normal calculation when T_L and T_R are sufficiently different
3134# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3135 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3136# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3137 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3138# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3139 end if
3140# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3141 gamma_avg = cp_avg/cv_avg
3142# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3143
3144# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3145 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3146# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3147 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3148# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3149 end if
3150# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3151 end if
3152# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3153
3154# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3155 if (avg_state == avg_state_arithmetic) then
3156# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3157 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3158# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3159 vel_avg_rms = 0._wp
3160# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3161
3162# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3163#if defined(MFC_OpenACC)
3164# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3165!$acc loop seq
3166# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3167#elif defined(MFC_OpenMP)
3168# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3169
3170# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3171#endif
3172# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3173 do i = 1, num_vels
3174# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3175 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3176# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3177 end do
3178# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3179
3180# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3181 h_avg = 5.e-1_wp*(h_l + h_r)
3182# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3183 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3184# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3185 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3186# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3187 end if
3188
3189 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, &
3190 & 0._wp, c_l, qv_l)
3191
3192 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, &
3193 & 0._wp, c_r, qv_r)
3194
3195 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3196 ! variables are placeholders to call the subroutine.
3197 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
3198 & vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
3199
3200 if (viscous) then
3201 if (chemistry) then
3202 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3203 end if
3204
3205# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3206#if defined(MFC_OpenACC)
3207# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3208!$acc loop seq
3209# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3210#elif defined(MFC_OpenMP)
3211# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3212
3213# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3214#endif
3215 do i = 1, 2
3216 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3217 end do
3218 end if
3219
3220 ! Low Mach correction
3221 if (low_mach == 2) then
3222 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3223# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3224 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3225# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3226 pcorr = 0._wp
3227# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3228
3229# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3230 if (low_mach == 1) then
3231# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3232 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3233# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3234 end if
3235# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3236 else if (riemann_solver == riemann_solver_hllc) then
3237# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3238 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3239# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3240 pcorr = 0._wp
3241# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3242
3243# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3244 if (low_mach == 1) then
3245# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3246 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
3247# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3248 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3249# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3250 else if (low_mach == 2) then
3251# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3252 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3253# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3254 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
3255# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3256 vel_l(dir_idx(1)) = vel_l_tmp
3257# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3258 vel_r(dir_idx(1)) = vel_r_tmp
3259# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3260 end if
3261# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3262 end if
3263 end if
3264
3265 if (wave_speeds == wave_speeds_direct) then
3266# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3267 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3268 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3269 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3270 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
3271 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
3272# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3273 else if (wave_speeds == wave_speeds_pressure) then
3274 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3275
3276 pres_sr = pres_sl
3277
3278 ! Low Mach correction: Thornber et al. JCP (2008)
3279 ms_l = max(1._wp, &
3280 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l &
3281 & - 1._wp)*pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3282 ms_r = max(1._wp, &
3283 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r &
3284 & - 1._wp)*pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3285
3286 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3287 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3288
3289 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3290 end if
3291
3292 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3293 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3294
3295 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3296 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3297 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3298 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
3299 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3300 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3301
3302 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3303 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
3304 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
3305
3306 ! Low Mach correction
3307 if (low_mach == 1) then
3308 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3309# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3310 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3311# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3312 pcorr = 0._wp
3313# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3314
3315# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3316 if (low_mach == 1) then
3317# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3318 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3319# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3320 end if
3321# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3322 else if (riemann_solver == riemann_solver_hllc) then
3323# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3324 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3325# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3326 pcorr = 0._wp
3327# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3328
3329# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3330 if (low_mach == 1) then
3331# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3332 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
3333# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3334 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3335# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3336 else if (low_mach == 2) then
3337# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3338 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3339# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3340 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
3341# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3342 vel_l(dir_idx(1)) = vel_l_tmp
3343# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3344 vel_r(dir_idx(1)) = vel_r_tmp
3345# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3346 end if
3347# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3348 end if
3349 else
3350 pcorr = 0._wp
3351 end if
3352
3353# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3354
3355 ! COMPUTING THE HLLC FLUXES MASS FLUX.
3356
3357# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3358#if defined(MFC_OpenACC)
3359# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3360!$acc loop seq
3361# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3362#elif defined(MFC_OpenMP)
3363# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3364
3365# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3366#endif
3367 do i = 1, eqn_idx%cont%end
3368 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3369 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3370 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3371 end do
3372
3373# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3374
3375# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3376#if defined(MFC_OpenACC)
3377# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3378!$acc loop seq
3379# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3380#elif defined(MFC_OpenMP)
3381# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3382
3383# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3384#endif
3385 do i = 1, num_dims
3386 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
3387 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
3388 flux_rsx_vf(j, k, l, &
3389 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
3390 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
3391 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
3392 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3393 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
3394 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
3395 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
3396 end do
3397
3398 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3399 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
3400 flux_rsx_vf(j, k, l, &
3401 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
3402 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
3403 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
3404 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
3405 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
3406# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3407
3408 ! VOLUME FRACTION FLUX.
3409
3410# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3411#if defined(MFC_OpenACC)
3412# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3413!$acc loop seq
3414# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3415#elif defined(MFC_OpenMP)
3416# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3417
3418# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3419#endif
3420 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3421 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3422 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3423 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3424 end do
3425
3426 ! VOLUME FRACTION SOURCE FLUX.
3427
3428# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3429#if defined(MFC_OpenACC)
3430# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3431!$acc loop seq
3432# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3433#elif defined(MFC_OpenMP)
3434# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3435
3436# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3437#endif
3438 do i = 1, num_dims
3439 vel_src_rsx_vf(j, k, l, &
3440 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
3441 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
3442 end do
3443
3444 ! COLOR FUNCTION FLUX
3445 if (surface_tension) then
3446 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
3447 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3448 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3449 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3450 end if
3451
3452 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3453
3454 if (chemistry) then
3455
3456# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3457#if defined(MFC_OpenACC)
3458# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3459!$acc loop seq
3460# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3461#elif defined(MFC_OpenMP)
3462# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3463
3464# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3465#endif
3466 do i = eqn_idx%species%beg, eqn_idx%species%end
3467 y_l = ql_prim_rsx_vf(j, k, l, i)
3468 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
3469
3470 flux_rsx_vf(j, k, l, &
3471 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3472 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3473 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
3474 end do
3475 end if
3476
3477# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3478
3479 ! Geometrical source flux for cylindrical coordinates
3480# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3481# 1538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3482 end do
3483 end do
3484 end do
3485
3486# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3487#if defined(MFC_OpenACC)
3488# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3489!$acc end parallel loop
3490# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3491#elif defined(MFC_OpenMP)
3492# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3493
3494# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3495!$omp end target teams loop
3496# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3497#endif
3498# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3499 end if
3500 end if
3501# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3502# 176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3503# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3504 if (norm_dir == 2) then
3505 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
3506 if (model_eqns == model_eqns_6eq) then
3507 ! 6-equation model (model_eqns=3): separate phasic internal energies
3508
3509# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3510
3511# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3512#if defined(MFC_OpenACC)
3513# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3514!$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, &
3515# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3516!$acc& Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, &
3517# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3518!$acc& 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, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, &
3519# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3520!$acc& vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, &
3521# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3522!$acc& xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP) firstprivate(Re_size_loc1, Re_size_loc2)
3523# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3524#elif defined(MFC_OpenMP)
3525# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3526
3527# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3528
3529# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3530
3531# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3532!$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, &
3533# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3534!$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, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, pcorr, zcoef, rho_L, rho_R, &
3535# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3536!$omp& pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, &
3537# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3538!$omp& 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, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, &
3539# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3540!$omp& 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) &
3541# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3542!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
3543# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3544#endif
3545# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3546 do l = is3%beg, is3%end
3547 do k = is1%beg, is1%end
3548 do j = is2%beg, is2%end
3549 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3550 rho_l = 0._wp; rho_r = 0._wp
3551 gamma_l = 0._wp; gamma_r = 0._wp
3552 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3553 qv_l = 0._wp; qv_r = 0._wp
3554 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
3555
3556
3557# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3558#if defined(MFC_OpenACC)
3559# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3560!$acc loop seq
3561# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3562#elif defined(MFC_OpenMP)
3563# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3564
3565# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3566#endif
3567 do i = 1, num_dims
3568 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3569 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3570 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3571 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3572 end do
3573
3574 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3575 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3576
3577 rho_l = 0._wp
3578 gamma_l = 0._wp
3579 pi_inf_l = 0._wp
3580 qv_l = 0._wp
3581
3582 rho_r = 0._wp
3583 gamma_r = 0._wp
3584 pi_inf_r = 0._wp
3585 qv_r = 0._wp
3586
3587 alpha_l_sum = 0._wp
3588 alpha_r_sum = 0._wp
3589
3590 if (mpp_lim) then
3591
3592# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3593#if defined(MFC_OpenACC)
3594# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3595!$acc loop seq
3596# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3597#elif defined(MFC_OpenMP)
3598# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3599
3600# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3601#endif
3602 do i = 1, num_fluids
3603 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
3604 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
3605 & eqn_idx%E + i)), 1._wp)
3606 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3607 end do
3608
3609
3610# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3611#if defined(MFC_OpenACC)
3612# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3613!$acc loop seq
3614# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3615#elif defined(MFC_OpenMP)
3616# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3617
3618# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3619#endif
3620 do i = 1, num_fluids
3621 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
3622 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
3623 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
3624 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3625 end do
3626
3627
3628# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3629#if defined(MFC_OpenACC)
3630# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3631!$acc loop seq
3632# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3633#elif defined(MFC_OpenMP)
3634# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3635
3636# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3637#endif
3638 do i = 1, num_fluids
3639 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
3640 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
3641 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
3642 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
3643 end do
3644 end if
3645
3646
3647# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3648#if defined(MFC_OpenACC)
3649# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3650!$acc loop seq
3651# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3652#elif defined(MFC_OpenMP)
3653# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3654
3655# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3656#endif
3657 do i = 1, num_fluids
3658 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3659 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3660 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
3661 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
3662 end do
3663
3664 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
3665 & qv_l)
3666 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
3667 & qv_r)
3668
3669 if (viscous) then
3670 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
3671 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
3672 end if
3673
3674 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
3675 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
3676
3677 h_l = (e_l + pres_l)/rho_l
3678 h_r = (e_r + pres_r)/rho_r
3679
3680 if (avg_state == avg_state_roe) then
3681# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3682 rho_avg = sqrt(rho_l*rho_r)
3683# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3684
3685# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3686 vel_avg_rms = 0._wp
3687# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3688
3689# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3690
3691# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3692#if defined(MFC_OpenACC)
3693# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3694!$acc loop seq
3695# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3696#elif defined(MFC_OpenMP)
3697# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3698
3699# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3700#endif
3701# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3702 do i = 1, num_vels
3703# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3704 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
3705# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3706 end do
3707# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3708
3709# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3710 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3711# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3712
3713# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3714 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3715# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3716
3717# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3718 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
3719# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3720
3721# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3722 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3723# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3724
3725# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3726 if (chemistry) then
3727# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3728 eps = 0.001_wp
3729# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3730 call get_species_enthalpies_rt(t_l, h_il)
3731# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3732 call get_species_enthalpies_rt(t_r, h_ir)
3733# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3734 h_il = h_il*gas_constant/molecular_weights*t_l
3735# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3736 h_ir = h_ir*gas_constant/molecular_weights*t_r
3737# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3738 call get_species_specific_heats_r(t_l, cp_il)
3739# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3740 call get_species_specific_heats_r(t_r, cp_ir)
3741# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3742
3743# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3744 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3745# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3746 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3747# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3748 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3749# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3750 if (abs(t_l - t_r) < eps) then
3751# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3752 ! Case when T_L and T_R are very close
3753# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3754 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3755# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3756 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3757# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3758 & - gas_constant/molecular_weights(:)))
3759# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3760 else
3761# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3762 ! Normal calculation when T_L and T_R are sufficiently different
3763# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3764 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3765# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3766 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3767# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3768 end if
3769# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3770 gamma_avg = cp_avg/cv_avg
3771# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3772
3773# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3774 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3775# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3776 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3777# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3778 end if
3779# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3780 end if
3781# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3782
3783# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3784 if (avg_state == avg_state_arithmetic) then
3785# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3786 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3787# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3788 vel_avg_rms = 0._wp
3789# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3790
3791# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3792#if defined(MFC_OpenACC)
3793# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3794!$acc loop seq
3795# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3796#elif defined(MFC_OpenMP)
3797# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3798
3799# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3800#endif
3801# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3802 do i = 1, num_vels
3803# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3804 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3805# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3806 end do
3807# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3808
3809# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3810 h_avg = 5.e-1_wp*(h_l + h_r)
3811# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3812 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3813# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3814 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3815# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3816 end if
3817
3818 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
3819 & c_l, qv_l)
3820
3821 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
3822 & c_r, qv_r)
3823
3824 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3825 ! variables are placeholders to call the subroutine.
3826 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3827 & 0._wp, c_avg, qv_avg)
3828
3829 if (viscous) then
3830
3831# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3832#if defined(MFC_OpenACC)
3833# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3834!$acc loop seq
3835# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3836#elif defined(MFC_OpenMP)
3837# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3838
3839# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3840#endif
3841 do i = 1, 2
3842 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3843 end do
3844 end if
3845
3846 ! Low Mach correction
3847 if (low_mach == 2) then
3848 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3849# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3850 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3851# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3852 pcorr = 0._wp
3853# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3854
3855# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3856 if (low_mach == 1) then
3857# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3858 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3859# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3860 end if
3861# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3862 else if (riemann_solver == riemann_solver_hllc) then
3863# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3864 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3865# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3866 pcorr = 0._wp
3867# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3868
3869# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3870 if (low_mach == 1) then
3871# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3872 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
3873# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3874 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3875# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3876 else if (low_mach == 2) then
3877# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3878 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3879# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3880 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
3881# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3882 vel_l(dir_idx(1)) = vel_l_tmp
3883# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3884 vel_r(dir_idx(1)) = vel_r_tmp
3885# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3886 end if
3887# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3888 end if
3889 end if
3890
3891 ! COMPUTING THE DIRECT WAVE SPEEDS
3892 if (wave_speeds == wave_speeds_direct) then
3893 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3894 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3895 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3896 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3897 & - rho_r*(s_r - vel_r(dir_idx(1))))
3898 else if (wave_speeds == wave_speeds_pressure) then
3899 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3900
3901 pres_sr = pres_sl
3902
3903 ! Low Mach correction: Thornber et al. JCP (2008)
3904 ms_l = max(1._wp, &
3905 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3906 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3907 ms_r = max(1._wp, &
3908 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3909 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3910
3911 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3912 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3913
3914 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3915 end if
3916
3917 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3918 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3919
3920 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3921 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3922 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3923 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3924 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3925
3926 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3927 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
3928 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
3929
3930 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
3931 xi_mp = -min(0._wp, sign(1._wp, s_l))
3932 xi_pp = max(0._wp, sign(1._wp, s_r))
3933
3934 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 &
3935 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
3936 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
3937 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
3938 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
3939
3940 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))
3941
3942 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 &
3943 & - vel_r(dir_idx(1)))
3944
3945 ! Low Mach correction
3946 if (low_mach == 1) then
3947 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3948# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3949 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3950# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3951 pcorr = 0._wp
3952# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3953
3954# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3955 if (low_mach == 1) then
3956# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3957 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3958# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3959 end if
3960# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3961 else if (riemann_solver == riemann_solver_hllc) then
3962# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3963 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3964# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3965 pcorr = 0._wp
3966# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3967
3968# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3969 if (low_mach == 1) then
3970# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3971 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
3972# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3973 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3974# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3975 else if (low_mach == 2) then
3976# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3977 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3978# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3979 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
3980# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3981 vel_l(dir_idx(1)) = vel_l_tmp
3982# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3983 vel_r(dir_idx(1)) = vel_r_tmp
3984# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3985 end if
3986# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3987 end if
3988 else
3989 pcorr = 0._wp
3990 end if
3991
3992 ! COMPUTING FLUXES MASS FLUX.
3993
3994# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3995#if defined(MFC_OpenACC)
3996# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3997!$acc loop seq
3998# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3999#elif defined(MFC_OpenMP)
4000# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4001
4002# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4003#endif
4004 do i = 1, eqn_idx%cont%end
4005 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4006 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4007 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4008 end do
4009
4010 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4011
4012# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4013#if defined(MFC_OpenACC)
4014# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4015!$acc loop seq
4016# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4017#elif defined(MFC_OpenMP)
4018# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4019
4020# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4021#endif
4022 do i = 1, num_dims
4023 flux_rsx_vf(j, k, l, &
4024 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
4025 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
4026 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
4027 & *dir_flg(dir_idx(i))*pcorr
4028 end do
4029
4030 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
4031 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
4032
4033 ! VOLUME FRACTION FLUX.
4034
4035# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4036#if defined(MFC_OpenACC)
4037# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4038!$acc loop seq
4039# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4040#elif defined(MFC_OpenMP)
4041# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4042
4043# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4044#endif
4045 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4046 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4047 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
4048 end do
4049
4050 ! Advection velocity source: interface velocity for volume fraction transport
4051
4052# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4053#if defined(MFC_OpenACC)
4054# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4055!$acc loop seq
4056# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4057#elif defined(MFC_OpenMP)
4058# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4059
4060# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4061#endif
4062 do i = 1, num_dims
4063 vel_src_rsx_vf(j, k, l, &
4064 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4065 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
4066 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
4067 end do
4068
4069 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
4070 ! energy flux
4071
4072# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4073#if defined(MFC_OpenACC)
4074# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4075!$acc loop seq
4076# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4077#elif defined(MFC_OpenMP)
4078# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4079
4080# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4081#endif
4082 do i = 1, num_fluids
4083 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
4084 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
4085 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
4086 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
4087 & + pres_r)
4088
4089 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
4090 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4091 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
4092 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
4093 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4094 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
4095 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
4096 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4097 & i + eqn_idx%adv%beg - 1))
4098 end do
4099
4100 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4101
4102 ! COLOR FUNCTION FLUX
4103 if (surface_tension) then
4104 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
4105 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
4106 end if
4107
4108 ! Geometrical source flux for cylindrical coordinates
4109# 429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4110 if (cyl_coord) then
4111 ! Substituting the advective flux into the inviscid geometrical source flux
4112
4113# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4114#if defined(MFC_OpenACC)
4115# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4116!$acc loop seq
4117# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4118#elif defined(MFC_OpenMP)
4119# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4120
4121# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4122#endif
4123 do i = 1, eqn_idx%E
4124 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4125 end do
4126
4127# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4128#if defined(MFC_OpenACC)
4129# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4130!$acc loop seq
4131# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4132#elif defined(MFC_OpenMP)
4133# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4134
4135# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4136#endif
4137 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
4138 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4139 end do
4140 ! Recalculating the radial momentum geometric source flux
4141 flux_gsrc_rsx_vf(j, k, l, &
4142 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
4143 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
4144 ! Geometrical source of the void fraction(s) is zero
4145
4146# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4147#if defined(MFC_OpenACC)
4148# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4149!$acc loop seq
4150# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4151#elif defined(MFC_OpenMP)
4152# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4153
4154# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4155#endif
4156 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4157 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4158 end do
4159 end if
4160# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4161# 463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4162 end do
4163 end do
4164 end do
4165
4166# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4167#if defined(MFC_OpenACC)
4168# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4169!$acc end parallel loop
4170# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4171#elif defined(MFC_OpenMP)
4172# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4173
4174# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4175!$omp end target teams loop
4176# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4177#endif
4178 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
4179 ! 5-equation model with Euler-Euler bubble dynamics
4180
4181# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4182
4183# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4184#if defined(MFC_OpenACC)
4185# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4186!$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, &
4187# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4188!$acc& gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, &
4189# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4190!$acc& vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, &
4191# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4192!$acc& PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) &
4193# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4194!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
4195# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4196#elif defined(MFC_OpenMP)
4197# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4198
4199# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4200
4201# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4202
4203# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4204!$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, &
4205# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4206!$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, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, &
4207# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4208!$omp& E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, &
4209# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4210!$omp& alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, &
4211# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4212!$omp& Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2)
4213# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4214#endif
4215# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4216 do l = is3%beg, is3%end
4217 do k = is1%beg, is1%end
4218 do j = is2%beg, is2%end
4219 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4220 rho_l = 0._wp; rho_r = 0._wp
4221 gamma_l = 0._wp; gamma_r = 0._wp
4222 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4223 qv_l = 0._wp; qv_r = 0._wp
4224
4225
4226# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4227#if defined(MFC_OpenACC)
4228# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4229!$acc loop seq
4230# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4231#elif defined(MFC_OpenMP)
4232# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4233
4234# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4235#endif
4236 do i = 1, num_fluids
4237 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4238 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4239 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4240 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4241 end do
4242
4243 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4244
4245
4246# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4247#if defined(MFC_OpenACC)
4248# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4249!$acc loop seq
4250# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4251#elif defined(MFC_OpenMP)
4252# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4253
4254# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4255#endif
4256 do i = 1, num_dims
4257 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4258 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4259 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4260 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4261 end do
4262
4263 ! Retain this in the refactor
4264 if (mpp_lim .and. (num_fluids > 2)) then
4265 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, &
4266 & pi_inf_l, qv_l)
4267 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, &
4268 & pi_inf_r, qv_r)
4269 else if (num_fluids > 2) then
4270 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_l, alpha_l, rho_l, gamma_l, &
4271 & pi_inf_l, qv_l)
4272 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_r, alpha_r, rho_r, gamma_r, &
4273 & pi_inf_r, qv_r)
4274 else
4275 rho_l = ql_prim_rsx_vf(j, k, l, 1)
4276 gamma_l = gammas(1)
4277 pi_inf_l = pi_infs(1)
4278 qv_l = qvs(1)
4279 rho_r = qr_prim_rsx_vf(j, k + 1, l, 1)
4280 gamma_r = gammas(1)
4281 pi_inf_r = pi_infs(1)
4282 qv_r = qvs(1)
4283 end if
4284
4285 if (viscous) then
4286 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
4287
4288# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4289#if defined(MFC_OpenACC)
4290# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4291!$acc loop seq
4292# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4293#elif defined(MFC_OpenMP)
4294# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4295
4296# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4297#endif
4298 do i = 1, 2
4299 re_l(i) = dflt_real
4300 re_r(i) = dflt_real
4301
4302 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
4303 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
4304
4305
4306# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4307#if defined(MFC_OpenACC)
4308# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4309!$acc loop seq
4310# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4311#elif defined(MFC_OpenMP)
4312# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4313
4314# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4315#endif
4316 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
4317 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
4318 & q)))/res_gs(i, q) + re_l(i)
4319 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
4320 & q)))/res_gs(i, q) + re_r(i)
4321 end do
4322
4323 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4324 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4325 end do
4326 end if
4327 end if
4328
4329 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4330 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4331
4332 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
4333 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
4334
4335 h_l = (e_l + pres_l)/rho_l
4336 h_r = (e_r + pres_r)/rho_r
4337
4338 if (avg_state == avg_state_arithmetic) then
4339
4340# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4341#if defined(MFC_OpenACC)
4342# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4343!$acc loop seq
4344# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4345#elif defined(MFC_OpenMP)
4346# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4347
4348# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4349#endif
4350 do i = 1, nb
4351 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
4352 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
4353
4354 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
4355 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
4356 if (.not. polytropic .and. .not. qbmm) then
4357 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
4358 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
4359 end if
4360 end do
4361
4362 if (.not. qbmm) then
4363 if (adv_n) then
4364 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
4365 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
4366 else
4367 nbub_l = 0._wp
4368 nbub_r = 0._wp
4369
4370# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4371#if defined(MFC_OpenACC)
4372# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4373!$acc loop seq
4374# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4375#elif defined(MFC_OpenMP)
4376# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4377
4378# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4379#endif
4380 do i = 1, nb
4381 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
4382 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
4383 end do
4384
4385 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
4386 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
4387 & eqn_idx%E + num_fluids)/nbub_r
4388 end if
4389 else
4390 ! nb stored in 0th moment of first R0 bin in variable conversion module
4391 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
4392 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
4393 end if
4394
4395
4396# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4397#if defined(MFC_OpenACC)
4398# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4399!$acc loop seq
4400# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4401#elif defined(MFC_OpenMP)
4402# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4403
4404# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4405#endif
4406 do i = 1, nb
4407 if (.not. qbmm) then
4408 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
4409 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
4410 end if
4411 end do
4412
4413 if (qbmm) then
4414 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
4415 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
4416
4417 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
4418 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
4419
4420 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
4421 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
4422 else
4423 pbwr3lbar = 0._wp
4424 pbwr3rbar = 0._wp
4425
4426 r3lbar = 0._wp
4427 r3rbar = 0._wp
4428
4429 r3v2lbar = 0._wp
4430 r3v2rbar = 0._wp
4431
4432
4433# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4434#if defined(MFC_OpenACC)
4435# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4436!$acc loop seq
4437# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4438#elif defined(MFC_OpenMP)
4439# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4440
4441# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4442#endif
4443 do i = 1, nb
4444 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
4445 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
4446
4447 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
4448 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
4449
4450 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
4451 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
4452 end do
4453 end if
4454
4455 rho_avg = 5.e-1_wp*(rho_l + rho_r)
4456 h_avg = 5.e-1_wp*(h_l + h_r)
4457 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
4458 qv_avg = 5.e-1_wp*(qv_l + qv_r)
4459 vel_avg_rms = 0._wp
4460
4461
4462# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4463#if defined(MFC_OpenACC)
4464# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4465!$acc loop seq
4466# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4467#elif defined(MFC_OpenMP)
4468# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4469
4470# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4471#endif
4472 do i = 1, num_dims
4473 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
4474 end do
4475 end if
4476
4477 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
4478 & c_l, qv_l)
4479
4480 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
4481 & c_r, qv_r)
4482
4483 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
4484 ! variables are placeholders to call the subroutine.
4485 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
4486 & 0._wp, c_avg, qv_avg)
4487
4488 if (viscous) then
4489
4490# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4491#if defined(MFC_OpenACC)
4492# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4493!$acc loop seq
4494# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4495#elif defined(MFC_OpenMP)
4496# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4497
4498# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4499#endif
4500 do i = 1, 2
4501 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
4502 end do
4503 end if
4504
4505 ! Low Mach correction
4506 if (low_mach == 2) then
4507 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
4508# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4509 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4510# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4511 pcorr = 0._wp
4512# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4513
4514# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4515 if (low_mach == 1) then
4516# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4517 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4518# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4519 end if
4520# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4521 else if (riemann_solver == riemann_solver_hllc) then
4522# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4523 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4524# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4525 pcorr = 0._wp
4526# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4527
4528# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4529 if (low_mach == 1) then
4530# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4531 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
4532# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4533 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4534# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4535 else if (low_mach == 2) then
4536# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4537 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4538# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4539 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
4540# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4541 vel_l(dir_idx(1)) = vel_l_tmp
4542# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4543 vel_r(dir_idx(1)) = vel_r_tmp
4544# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4545 end if
4546# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4547 end if
4548 end if
4549
4550 if (wave_speeds == wave_speeds_direct) then
4551 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
4552 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
4553
4554 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
4555 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
4556 & - rho_r*(s_r - vel_r(dir_idx(1))))
4557 else if (wave_speeds == wave_speeds_pressure) then
4558 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4559
4560 pres_sr = pres_sl
4561
4562 ! Low Mach correction: Thornber et al. JCP (2008)
4563 ms_l = max(1._wp, &
4564 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
4565 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
4566 ms_r = max(1._wp, &
4567 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
4568 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
4569
4570 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4571 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4572
4573 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4574 end if
4575
4576 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4577 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4578
4579 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4580 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4581 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4582 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4583 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4584
4585 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4586 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4587 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4588
4589 ! Low Mach correction
4590 if (low_mach == 1) then
4591 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
4592# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4593 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4594# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4595 pcorr = 0._wp
4596# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4597
4598# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4599 if (low_mach == 1) then
4600# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4601 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4602# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4603 end if
4604# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4605 else if (riemann_solver == riemann_solver_hllc) then
4606# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4607 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4608# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4609 pcorr = 0._wp
4610# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4611
4612# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4613 if (low_mach == 1) then
4614# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4615 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
4616# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4617 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4618# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4619 else if (low_mach == 2) then
4620# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4621 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4622# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4623 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
4624# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4625 vel_l(dir_idx(1)) = vel_l_tmp
4626# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4627 vel_r(dir_idx(1)) = vel_r_tmp
4628# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4629 end if
4630# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4631 end if
4632 else
4633 pcorr = 0._wp
4634 end if
4635
4636
4637# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4638#if defined(MFC_OpenACC)
4639# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4640!$acc loop seq
4641# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4642#elif defined(MFC_OpenMP)
4643# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4644
4645# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4646#endif
4647 do i = 1, eqn_idx%cont%end
4648 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4649 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4650 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4651 end do
4652
4653 if (bubbles_euler .and. (num_fluids > 1)) then
4654 ! Kill mass transport @ gas density
4655 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
4656 end if
4657
4658 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4659
4660 ! Include p_tilde
4661
4662 if (avg_state == avg_state_arithmetic) then
4663 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
4664 pres_l = pres_l - alpha_l(num_fluids)*pres_l
4665 else
4666 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
4667 end if
4668
4669 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
4670 pres_r = pres_r - alpha_r(num_fluids)*pres_r
4671 else
4672 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
4673 end if
4674 end if
4675
4676
4677# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4678#if defined(MFC_OpenACC)
4679# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4680!$acc loop seq
4681# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4682#elif defined(MFC_OpenMP)
4683# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4684
4685# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4686#endif
4687 do i = 1, num_dims
4688 flux_rsx_vf(j, k, l, &
4689 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
4690 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4691 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
4692 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4693 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4694 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
4695 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
4696 end do
4697
4698 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
4699 flux_rsx_vf(j, k, l, &
4700 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
4701 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
4702 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
4703 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
4704 & *pcorr*s_s
4705
4706 ! Volume fraction flux
4707
4708# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4709#if defined(MFC_OpenACC)
4710# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4711!$acc loop seq
4712# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4713#elif defined(MFC_OpenMP)
4714# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4715
4716# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4717#endif
4718 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4719 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4720 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4721 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4722 end do
4723
4724 ! Advection velocity source: interface velocity for volume fraction transport
4725
4726# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4727#if defined(MFC_OpenACC)
4728# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4729!$acc loop seq
4730# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4731#elif defined(MFC_OpenMP)
4732# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4733
4734# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4735#endif
4736 do i = 1, num_dims
4737 vel_src_rsx_vf(j, k, l, &
4738 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
4739 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
4740 end do
4741
4742 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4743
4744 ! Add advection flux for bubble variables
4745
4746# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4747#if defined(MFC_OpenACC)
4748# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4749!$acc loop seq
4750# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4751#elif defined(MFC_OpenMP)
4752# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4753
4754# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4755#endif
4756 do i = eqn_idx%bub%beg, eqn_idx%bub%end
4757 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
4758 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4759 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4760 end do
4761
4762 if (qbmm) then
4763 flux_rsx_vf(j, k, l, &
4764 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4765 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4766 end if
4767
4768 if (adv_n) then
4769 flux_rsx_vf(j, k, l, &
4770 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4771 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4772 end if
4773
4774 ! Geometrical source flux for cylindrical coordinates
4775# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4776 if (cyl_coord) then
4777 ! Substituting the advective flux into the inviscid geometrical source flux
4778
4779# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4780#if defined(MFC_OpenACC)
4781# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4782!$acc loop seq
4783# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4784#elif defined(MFC_OpenMP)
4785# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4786
4787# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4788#endif
4789 do i = 1, eqn_idx%E
4790 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4791 end do
4792 ! Recalculating the radial momentum geometric source flux
4793 flux_gsrc_rsx_vf(j, k, l, &
4794 & eqn_idx%cont%end + dir_idx(1)) &
4795 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l(dir_idx(1)), &
4796 & vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, &
4797 & dir_flg(dir_idx(1)))
4798 ! Geometrical source of the void fraction(s) is zero
4799
4800# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4801#if defined(MFC_OpenACC)
4802# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4803!$acc loop seq
4804# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4805#elif defined(MFC_OpenMP)
4806# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4807
4808# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4809#endif
4810 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4811 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4812 end do
4813 end if
4814# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4815# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4816 end do
4817 end do
4818 end do
4819
4820# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4821#if defined(MFC_OpenACC)
4822# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4823!$acc end parallel loop
4824# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4825#elif defined(MFC_OpenMP)
4826# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4827
4828# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4829!$omp end target teams loop
4830# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4831#endif
4832# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4833# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4834 else if (hypoelasticity) then
4835# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4836 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
4837 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
4838 ! statement and private variable from the pure-fluid emission, keeping its body and directive
4839 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
4840 ! pinned it at the GPU register ceiling for every HLLC user.
4841# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4842 ! Private list split across _hllc_p1/p2/p3 for Fypp line-length limits
4843# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4844# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4845# 861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4846# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4847# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4848 ! The two calls below are identical on purpose. An offload kernel is named
4849 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
4850 ! both emissions the same name; amdflang then launches the wrong one and a
4851 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
4852 ! give two line numbers. Do not merge them back into one.
4853# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4854
4855# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4856
4857# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4858#if defined(MFC_OpenACC)
4859# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4860!$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, &
4861# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4862!$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, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, &
4863# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4864!$acc& gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, &
4865# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4866!$acc& alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, ptilde_L, ptilde_R, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, Yi_avg, &
4867# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4868!$acc& Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R, damage_L, damage_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, &
4869# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4870!$acc& 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, 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, &
4871# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4872!$acc& 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, u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, &
4873# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4874!$acc& dSigma, Sigma_ref, a_L_ref, a_R_ref, 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) &
4875# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4876!$acc& copyin(is1, is2, is3)
4877# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4878#elif defined(MFC_OpenMP)
4879# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4880
4881# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4882
4883# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4884
4885# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4886!$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, &
4887# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4888!$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, &
4889# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4890!$omp& Cv_L, Cv_R, Cp_avg, Cv_avg, T_avg, eps, 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, &
4891# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4892!$omp& 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, vel_avg_rms, pcorr, zcoef, ptilde_L, ptilde_R, &
4893# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4894!$omp& vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R, damage_L, damage_R, U_L, U_R, F_L, F_R, &
4895# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4896!$omp& 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, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, &
4897# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4898!$omp& 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, u_t2_star, tau_nt2_star, pres_tot_star, &
4899# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4900!$omp& 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, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, &
4901# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4902!$omp& sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
4903# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4904#endif
4905# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4906# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4907 do l = is3%beg, is3%end
4908 do k = is1%beg, is1%end
4909 do j = is2%beg, is2%end
4910 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4911 rho_l = 0._wp; rho_r = 0._wp
4912 gamma_l = 0._wp; gamma_r = 0._wp
4913 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4914 qv_l = 0._wp; qv_r = 0._wp
4915 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
4916
4917
4918# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4919#if defined(MFC_OpenACC)
4920# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4921!$acc loop seq
4922# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4923#elif defined(MFC_OpenMP)
4924# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4925
4926# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4927#endif
4928 do i = 1, num_fluids
4929 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4930 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4931 end do
4932
4933
4934# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4935#if defined(MFC_OpenACC)
4936# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4937!$acc loop seq
4938# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4939#elif defined(MFC_OpenMP)
4940# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4941
4942# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4943#endif
4944 do i = 1, num_dims
4945 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4946 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4947 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4948 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4949 end do
4950
4951 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4952 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4953
4954# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4955
4956# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4957#if defined(MFC_OpenACC)
4958# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4959!$acc loop seq
4960# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4961#elif defined(MFC_OpenMP)
4962# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4963
4964# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4965#endif
4966 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4967 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4968 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4969 end do
4970
4971 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
4972 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
4973 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
4974 if (n > 0) then
4975 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
4976 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
4977 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
4978 end if
4979 if (p > 0) then
4980 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
4981 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
4982 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
4983 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
4984 end if
4985 pres_tot_l = pres_l - tau_nn_l
4986 pres_tot_r = pres_r - tau_nn_r
4987 if (cyl_coord) then
4988 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4989 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4990 else
4991 tau_qq_l = 0._wp
4992 tau_qq_r = 0._wp
4993 end if
4994# 936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4995
4996 ! Change this by splitting it into the cases present in the bubbles_euler
4997 if (mpp_lim) then
4998
4999# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5000#if defined(MFC_OpenACC)
5001# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5002!$acc loop seq
5003# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5004#elif defined(MFC_OpenMP)
5005# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5006
5007# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5008#endif
5009 do i = 1, num_fluids
5010 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5011 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5012 & eqn_idx%E + i)), 1._wp)
5013 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
5014 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
5015 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
5016 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5017 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5018 end do
5019
5020
5021# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5022#if defined(MFC_OpenACC)
5023# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5024!$acc loop seq
5025# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5026#elif defined(MFC_OpenMP)
5027# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5028
5029# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5030#endif
5031 do i = 1, num_fluids
5032 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5033 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5034 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
5035 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5036 end do
5037 end if
5038
5039 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
5040 ! downstream
5041
5042# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5043#if defined(MFC_OpenACC)
5044# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5045!$acc loop seq
5046# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5047#elif defined(MFC_OpenMP)
5048# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5049
5050# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5051#endif
5052 do i = 1, num_fluids
5053 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5054 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
5055 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5056 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5057 end do
5058
5059 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
5060 & pi_inf_l, qv_l)
5061 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
5062 & pi_inf_r, qv_r)
5063
5064 if (viscous) then
5065 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
5066 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
5067 end if
5068
5069 if (chemistry) then
5070 c_sum_yi_phi = 0.0_wp
5071
5072# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5073#if defined(MFC_OpenACC)
5074# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5075!$acc loop seq
5076# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5077#elif defined(MFC_OpenMP)
5078# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5079
5080# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5081#endif
5082 do i = eqn_idx%species%beg, eqn_idx%species%end
5083 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5084 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
5085 end do
5086
5087 call get_mixture_molecular_weight(ys_l, mw_l)
5088 call get_mixture_molecular_weight(ys_r, mw_r)
5089
5090 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5091 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5092
5093 r_gas_l = gas_constant/mw_l
5094 r_gas_r = gas_constant/mw_r
5095
5096 t_l = pres_l/rho_l/r_gas_l
5097 t_r = pres_r/rho_r/r_gas_r
5098
5099 call get_species_specific_heats_r(t_l, cp_il)
5100 call get_species_specific_heats_r(t_r, cp_ir)
5101
5102 if (chem_params%gamma_method == 1) then
5103 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5104 gamma_il = cp_il/(cp_il - 1.0_wp)
5105 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5106
5107 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5108 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5109 else if (chem_params%gamma_method == 2) then
5110 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5111 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5112 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5113 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5114 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5115
5116 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
5117 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5118 end if
5119
5120 call get_mixture_energy_mass(t_l, ys_l, e_l)
5121 call get_mixture_energy_mass(t_r, ys_r, e_r)
5122
5123 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5124 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5125 h_l = (e_l + pres_l)/rho_l
5126 h_r = (e_r + pres_r)/rho_r
5127 else
5128 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5129 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5130
5131 h_l = (e_l + pres_l)/rho_l
5132 h_r = (e_r + pres_r)/rho_r
5133 end if
5134
5135# 1037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5136 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
5137
5138# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5139#if defined(MFC_OpenACC)
5140# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5141!$acc loop seq
5142# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5143#elif defined(MFC_OpenMP)
5144# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5145
5146# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5147#endif
5148 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5149 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5150 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
5151 end do
5152 damage_l = 0._wp; damage_r = 0._wp
5153 if (cont_damage) then
5154 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
5155 damage_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%damage)
5156 end if
5157
5158 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
5159 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
5160 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
5161 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
5162 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
5163 ! keep their pre-adjustment values here.
5164# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5165
5166 if (avg_state == avg_state_roe) then
5167# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5168 rho_avg = sqrt(rho_l*rho_r)
5169# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5170
5171# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5172 vel_avg_rms = 0._wp
5173# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5174
5175# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5176
5177# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5178#if defined(MFC_OpenACC)
5179# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5180!$acc loop seq
5181# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5182#elif defined(MFC_OpenMP)
5183# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5184
5185# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5186#endif
5187# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5188 do i = 1, num_vels
5189# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5190 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
5191# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5192 end do
5193# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5194
5195# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5196 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
5197# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5198
5199# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5200 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
5201# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5202
5203# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5204 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
5205# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5206
5207# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5208 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
5209# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5210
5211# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5212 if (chemistry) then
5213# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5214 eps = 0.001_wp
5215# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5216 call get_species_enthalpies_rt(t_l, h_il)
5217# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5218 call get_species_enthalpies_rt(t_r, h_ir)
5219# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5220 h_il = h_il*gas_constant/molecular_weights*t_l
5221# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5222 h_ir = h_ir*gas_constant/molecular_weights*t_r
5223# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5224 call get_species_specific_heats_r(t_l, cp_il)
5225# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5226 call get_species_specific_heats_r(t_r, cp_ir)
5227# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5228
5229# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5230 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
5231# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5232 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
5233# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5234 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
5235# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5236 if (abs(t_l - t_r) < eps) then
5237# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5238 ! Case when T_L and T_R are very close
5239# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5240 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
5241# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5242 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
5243# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5244 & - gas_constant/molecular_weights(:)))
5245# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5246 else
5247# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5248 ! Normal calculation when T_L and T_R are sufficiently different
5249# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5250 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
5251# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5252 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
5253# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5254 end if
5255# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5256 gamma_avg = cp_avg/cv_avg
5257# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5258
5259# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5260 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
5261# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5262 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
5263# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5264 end if
5265# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5266 end if
5267# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5268
5269# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5270 if (avg_state == avg_state_arithmetic) then
5271# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5272 rho_avg = 5.e-1_wp*(rho_l + rho_r)
5273# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5274 vel_avg_rms = 0._wp
5275# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5276
5277# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5278#if defined(MFC_OpenACC)
5279# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5280!$acc loop seq
5281# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5282#elif defined(MFC_OpenMP)
5283# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5284
5285# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5286#endif
5287# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5288 do i = 1, num_vels
5289# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5290 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
5291# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5292 end do
5293# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5294
5295# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5296 h_avg = 5.e-1_wp*(h_l + h_r)
5297# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5298 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
5299# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5300 qv_avg = 5.e-1_wp*(qv_l + qv_r)
5301# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5302 end if
5303
5304 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, &
5305 & 0._wp, c_l, qv_l)
5306
5307 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, &
5308 & 0._wp, c_r, qv_r)
5309
5310 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
5311 ! variables are placeholders to call the subroutine.
5312 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
5313 & vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
5314
5315 if (viscous) then
5316 if (chemistry) then
5317 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
5318 end if
5319
5320# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5321#if defined(MFC_OpenACC)
5322# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5323!$acc loop seq
5324# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5325#elif defined(MFC_OpenMP)
5326# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5327
5328# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5329#endif
5330 do i = 1, 2
5331 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5332 end do
5333 end if
5334
5335 ! Low Mach correction
5336 if (low_mach == 2) then
5337 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5338# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5339 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5340# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5341 pcorr = 0._wp
5342# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5343
5344# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5345 if (low_mach == 1) then
5346# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5347 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5348# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5349 end if
5350# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5351 else if (riemann_solver == riemann_solver_hllc) then
5352# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5353 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5354# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5355 pcorr = 0._wp
5356# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5357
5358# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5359 if (low_mach == 1) then
5360# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5361 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
5362# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5363 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5364# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5365 else if (low_mach == 2) then
5366# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5367 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5368# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5369 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
5370# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5371 vel_l(dir_idx(1)) = vel_l_tmp
5372# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5373 vel_r(dir_idx(1)) = vel_r_tmp
5374# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5375 end if
5376# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5377 end if
5378 end if
5379
5380 if (wave_speeds == wave_speeds_direct) then
5381# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5382 ! Elastic wave speed, Rodriguez et al. JCP (2019)
5383 s_l = min(vel_l(dir_idx(1)) - sqrt(max(verysmall, c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l)), &
5384# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5385 & vel_r(dir_idx(1)) - sqrt(max(verysmall, c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r)))
5386# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5387 s_r = max(vel_r(dir_idx(1)) + sqrt(max(verysmall, c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r)), &
5388# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5389 & vel_l(dir_idx(1)) + sqrt(max(verysmall, c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l)))
5390 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
5391 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
5392 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
5393 & - vel_r(dir_idx(1))))
5394# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5395 else if (wave_speeds == wave_speeds_pressure) then
5396 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5397
5398 pres_sr = pres_sl
5399
5400 ! Low Mach correction: Thornber et al. JCP (2008)
5401 ms_l = max(1._wp, &
5402 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l &
5403 & - 1._wp)*pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
5404 ms_r = max(1._wp, &
5405 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r &
5406 & - 1._wp)*pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
5407
5408 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5409 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5410
5411 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5412 end if
5413
5414 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5415 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5416
5417 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5418 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5419 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5420 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
5421 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5422 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5423
5424 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5425 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5426 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5427
5428 ! Low Mach correction
5429 if (low_mach == 1) then
5430 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5431# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5432 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5433# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5434 pcorr = 0._wp
5435# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5436
5437# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5438 if (low_mach == 1) then
5439# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5440 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5441# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5442 end if
5443# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5444 else if (riemann_solver == riemann_solver_hllc) then
5445# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5446 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5447# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5448 pcorr = 0._wp
5449# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5450
5451# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5452 if (low_mach == 1) then
5453# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5454 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
5455# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5456 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5457# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5458 else if (low_mach == 2) then
5459# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5460 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5461# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5462 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
5463# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5464 vel_l(dir_idx(1)) = vel_l_tmp
5465# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5466 vel_r(dir_idx(1)) = vel_r_tmp
5467# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5468 end if
5469# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5470 end if
5471 else
5472 pcorr = 0._wp
5473 end if
5474
5475# 1144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5476 if (n == 0) then
5477 u_t_l = 0._wp; u_t_r = 0._wp
5478 tau_nt_l = 0._wp; tau_nt_r = 0._wp
5479 end if
5480 if (p == 0) then
5481 u_t2_l = 0._wp; u_t2_r = 0._wp
5482 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
5483 end if
5484 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
5485 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
5486 denom_a = a_r - a_l
5487 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
5488 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
5489 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
5490 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
5491 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
5492# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5493
5494 ! COMPUTING THE HLLC FLUXES MASS FLUX.
5495
5496# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5497#if defined(MFC_OpenACC)
5498# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5499!$acc loop seq
5500# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5501#elif defined(MFC_OpenMP)
5502# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5503
5504# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5505#endif
5506 do i = 1, eqn_idx%cont%end
5507 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5508 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5509 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5510 end do
5511
5512# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5513 flux_rsx_vf(j, k, l, &
5514 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
5515 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
5516 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
5517 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
5518 if (n > 0) then
5519 flux_rsx_vf(j, k, l, &
5520 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
5521 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
5522 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
5523 & - tau_nt_r)
5524 end if
5525 if (p > 0) then
5526 flux_rsx_vf(j, k, l, &
5527 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
5528 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
5529 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
5530 & - tau_nt2_r)
5531 end if
5532
5533 flux_rsx_vf(j, k, l, &
5534 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
5535 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
5536 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
5537 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
5538 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
5539 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
5540 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
5541 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
5542 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
5543 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
5544
5545 if (n == 0) then
5546 flux_rsx_vf(j, k, l, &
5547 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
5548 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
5549 & + s_p*(xi_r - 1._wp))
5550 else if (p == 0) then
5551 if (dir_idx(1) == 1) then
5552 flux_rsx_vf(j, k, l, &
5553 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
5554 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
5555 & + s_p*(xi_r - 1._wp))
5556 flux_rsx_vf(j, k, l, &
5557 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
5558 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
5559 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
5560 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
5561 flux_rsx_vf(j, k, l, &
5562 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
5563 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
5564 & + s_p*(xi_r - 1._wp))
5565 else
5566 flux_rsx_vf(j, k, l, &
5567 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
5568 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
5569 & + s_p*(xi_r - 1._wp))
5570 flux_rsx_vf(j, k, l, &
5571 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
5572 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
5573 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
5574 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
5575 flux_rsx_vf(j, k, l, &
5576 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
5577 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
5578 & + s_p*(xi_r - 1._wp))
5579 end if
5580 else
5581 flux_rsx_vf(j, k, l, &
5582 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
5583 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
5584 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
5585 flux_rsx_vf(j, k, l, &
5586 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
5587 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
5588 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
5589 & - rho_r*tau_nt_r))
5590 flux_rsx_vf(j, k, l, &
5591 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
5592 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
5593 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
5594 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
5595 flux_rsx_vf(j, k, l, &
5596 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
5597 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
5598 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
5599 flux_rsx_vf(j, k, l, &
5600 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
5601 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
5602 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
5603 flux_rsx_vf(j, k, l, &
5604 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
5605 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
5606 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
5607 end if
5608 if (cyl_coord) then
5609 flux_rsx_vf(j, k, l, &
5610 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
5611 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
5612 & + s_p*(xi_r - 1._wp))
5613 end if
5614
5615 if (s_l >= 0._wp) then
5616 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
5617 else if (s_r <= 0._wp) then
5618 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
5619 else
5620 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
5621 end if
5622 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
5623 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
5624 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
5625# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5626
5627 ! VOLUME FRACTION FLUX.
5628
5629# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5630#if defined(MFC_OpenACC)
5631# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5632!$acc loop seq
5633# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5634#elif defined(MFC_OpenMP)
5635# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5636
5637# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5638#endif
5639 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5640 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5641 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5642 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5643 end do
5644
5645 ! VOLUME FRACTION SOURCE FLUX.
5646
5647# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5648#if defined(MFC_OpenACC)
5649# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5650!$acc loop seq
5651# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5652#elif defined(MFC_OpenMP)
5653# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5654
5655# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5656#endif
5657 do i = 1, num_dims
5658 vel_src_rsx_vf(j, k, l, &
5659 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
5660 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
5661 end do
5662
5663 ! COLOR FUNCTION FLUX
5664 if (surface_tension) then
5665 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
5666 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5667 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5668 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5669 end if
5670
5671 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5672
5673 if (chemistry) then
5674
5675# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5676#if defined(MFC_OpenACC)
5677# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5678!$acc loop seq
5679# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5680#elif defined(MFC_OpenMP)
5681# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5682
5683# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5684#endif
5685 do i = eqn_idx%species%beg, eqn_idx%species%end
5686 y_l = ql_prim_rsx_vf(j, k, l, i)
5687 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5688
5689 flux_rsx_vf(j, k, l, &
5690 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5691 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5692 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
5693 end do
5694 end if
5695
5696# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5697 ! HLLC-ADC blending for hypoelasticity
5698 if (riemann_hypo_adc) then
5699 ! Build U_L, U_R and F_L, F_R in local-basis layout
5700
5701# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5702#if defined(MFC_OpenACC)
5703# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5704!$acc loop seq
5705# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5706#elif defined(MFC_OpenMP)
5707# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5708
5709# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5710#endif
5711 do i = 1, num_fluids
5712 u_l(i) = alpha_rho_l(i)
5713 u_r(i) = alpha_rho_r(i)
5714 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
5715 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
5716 f_l(i) = alpha_rho_l(i)*u_n_l
5717 f_r(i) = alpha_rho_r(i)*u_n_r
5718 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
5719 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
5720 end do
5721
5722 ! Momentum U/F in physical order via dir_idx
5723 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
5724 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
5725 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
5726 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
5727 if (n > 0) then
5728 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
5729 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
5730 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
5731 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
5732 end if
5733 if (p > 0) then
5734 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
5735 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
5736 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
5737 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
5738 end if
5739
5740 u_l(eqn_idx%E) = e_l
5741 u_r(eqn_idx%E) = e_r
5742 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
5743 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
5744
5745 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
5746
5747# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5748#if defined(MFC_OpenACC)
5749# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5750!$acc loop seq
5751# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5752#elif defined(MFC_OpenMP)
5753# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5754
5755# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5756#endif
5757 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
5758 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
5759 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
5760 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
5761 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
5762 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
5763 end do
5764 if (cyl_coord) then
5765 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
5766 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
5767 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
5768 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
5769 end if
5770
5771 ! Compute F_HLL (physical order) and HLL trace velocities
5772 if (s_l >= 0._wp) then
5773
5774# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5775#if defined(MFC_OpenACC)
5776# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5777!$acc loop seq
5778# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5779#elif defined(MFC_OpenMP)
5780# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5781
5782# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5783#endif
5784 do i = 1, sys_size
5785 f_hll(i) = f_l(i)
5786 end do
5787 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
5788 else if (s_r <= 0._wp) then
5789
5790# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5791#if defined(MFC_OpenACC)
5792# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5793!$acc loop seq
5794# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5795#elif defined(MFC_OpenMP)
5796# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5797
5798# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5799#endif
5800 do i = 1, sys_size
5801 f_hll(i) = f_r(i)
5802 end do
5803 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
5804 else
5805
5806# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5807#if defined(MFC_OpenACC)
5808# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5809!$acc loop seq
5810# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5811#elif defined(MFC_OpenMP)
5812# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5813
5814# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5815#endif
5816 do i = 1, sys_size
5817 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 &
5818 & + verysmall)
5819 end do
5820 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
5821 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
5822 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
5823 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
5824 end if
5825
5826 ! ADC sensor
5827 sigma_l = pres_tot_l
5828 sigma_r = pres_tot_r
5829 dsigma = sigma_r - sigma_l
5830 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
5831
5832 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
5833 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
5834 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
5835
5836 du_t = u_t_r - u_t_l
5837 dtau_nt = tau_nt_r - tau_nt_l
5838 du_t2 = u_t2_r - u_t2_l
5839 dtau_nt2 = tau_nt2_r - tau_nt2_l
5840
5841 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
5842 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
5843 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
5844 & + verysmall)
5845
5846 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
5847 phi = exp(-(sensor_combined**adc_power))
5848
5849 ! Blend all flux components: F_HLL is in physical order
5850
5851# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5852#if defined(MFC_OpenACC)
5853# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5854!$acc loop seq
5855# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5856#elif defined(MFC_OpenMP)
5857# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5858
5859# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5860#endif
5861 do i = 1, sys_size
5862 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
5863 end do
5864
5865 ! Blend interface velocities (scalar HLL traces)
5866 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
5867 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
5868 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
5869
5870 ! Overwrite vel_src with blended velocities
5871 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
5872 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
5873 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
5874
5875 ! Update advection source flux with ADC-blended face-normal velocity
5876 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
5877
5878 ! Overwrite nc_iface_vel with blended velocities
5879 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
5880 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
5881 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
5882 end if
5883 ! END HLLC-ADC
5884# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5885
5886 ! Geometrical source flux for cylindrical coordinates
5887# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5888# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5889 if (cyl_coord) then
5890
5891# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5892#if defined(MFC_OpenACC)
5893# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5894!$acc loop seq
5895# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5896#elif defined(MFC_OpenMP)
5897# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5898
5899# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5900#endif
5901 do i = 1, sys_size
5902 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5903 end do
5904 if (s_l >= 0._wp) then
5905 p_face = pres_l; tau_qq_face = tau_qq_l
5906 else if (s_r <= 0._wp) then
5907 p_face = pres_r; tau_qq_face = tau_qq_r
5908 else if (s_s >= 0._wp) then
5909 p_face = pres_tot_star + tau_nn_l; tau_qq_face = tau_qq_l
5910 else
5911 p_face = pres_tot_star + tau_nn_r; tau_qq_face = tau_qq_r
5912 end if
5913 flux_gsrc_rsx_vf(j, k, l, &
5914 & eqn_idx%cont%end + dir_idx(1)) = flux_rsx_vf(j, k, l, &
5915 & eqn_idx%cont%end + dir_idx(1)) - p_face + tau_qq_face
5916
5917# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5918#if defined(MFC_OpenACC)
5919# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5920!$acc loop seq
5921# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5922#elif defined(MFC_OpenMP)
5923# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5924
5925# 1497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5926#endif
5927 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5928 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5929 end do
5930 end if
5931# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5932# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5933# 1538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5934 end do
5935 end do
5936 end do
5937
5938# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5939#if defined(MFC_OpenACC)
5940# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5941!$acc end parallel loop
5942# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5943#elif defined(MFC_OpenMP)
5944# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5945
5946# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5947!$omp end target teams loop
5948# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5949#endif
5950# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5951# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5952 else
5953# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5954 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
5955 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
5956 ! statement and private variable from the pure-fluid emission, keeping its body and directive
5957 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
5958 ! pinned it at the GPU register ceiling for every HLLC user.
5959# 863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5960 ! Master's pure-fluid private list, unchanged
5961# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5962# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5963 ! The two calls below are identical on purpose. An offload kernel is named
5964 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
5965 ! both emissions the same name; amdflang then launches the wrong one and a
5966 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
5967 ! give two line numbers. Do not merge them back into one.
5968# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5969
5970# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5971
5972# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5973#if defined(MFC_OpenACC)
5974# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5975!$acc parallel loop collapse(3) gang vector default(present) private(i, 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, &
5976# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5977!$acc& alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, &
5978# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5979!$acc& 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, vel_avg_rms, pcorr, zcoef, &
5980# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5981!$acc& vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
5982# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5983#elif defined(MFC_OpenMP)
5984# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5985
5986# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5987
5988# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5989
5990# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5991!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, T_L, T_R, &
5992# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5993!$omp& vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, &
5994# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5995!$omp& Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, &
5996# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5997!$omp& 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, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
5998# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5999!$omp& Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
6000# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6001#endif
6002# 877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6003# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6004 do l = is3%beg, is3%end
6005 do k = is1%beg, is1%end
6006 do j = is2%beg, is2%end
6007 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6008 rho_l = 0._wp; rho_r = 0._wp
6009 gamma_l = 0._wp; gamma_r = 0._wp
6010 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6011 qv_l = 0._wp; qv_r = 0._wp
6012 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6013
6014
6015# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6016#if defined(MFC_OpenACC)
6017# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6018!$acc loop seq
6019# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6020#elif defined(MFC_OpenMP)
6021# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6022
6023# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6024#endif
6025 do i = 1, num_fluids
6026 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6027 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
6028 end do
6029
6030
6031# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6032#if defined(MFC_OpenACC)
6033# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6034!$acc loop seq
6035# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6036#elif defined(MFC_OpenMP)
6037# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6038
6039# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6040#endif
6041 do i = 1, num_dims
6042 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6043 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
6044 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6045 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6046 end do
6047
6048 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6049 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
6050
6051# 936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6052
6053 ! Change this by splitting it into the cases present in the bubbles_euler
6054 if (mpp_lim) then
6055
6056# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6057#if defined(MFC_OpenACC)
6058# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6059!$acc loop seq
6060# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6061#elif defined(MFC_OpenMP)
6062# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6063
6064# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6065#endif
6066 do i = 1, num_fluids
6067 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6068 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6069 & eqn_idx%E + i)), 1._wp)
6070 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
6071 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
6072 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
6073 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6074 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
6075 end do
6076
6077
6078# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6079#if defined(MFC_OpenACC)
6080# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6081!$acc loop seq
6082# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6083#elif defined(MFC_OpenMP)
6084# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6085
6086# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6087#endif
6088 do i = 1, num_fluids
6089 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6090 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6091 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
6092 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6093 end do
6094 end if
6095
6096 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
6097 ! downstream
6098
6099# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6100#if defined(MFC_OpenACC)
6101# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6102!$acc loop seq
6103# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6104#elif defined(MFC_OpenMP)
6105# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6106
6107# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6108#endif
6109 do i = 1, num_fluids
6110 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
6111 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
6112 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6113 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
6114 end do
6115
6116 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
6117 & pi_inf_l, qv_l)
6118 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
6119 & pi_inf_r, qv_r)
6120
6121 if (viscous) then
6122 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
6123 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
6124 end if
6125
6126 if (chemistry) then
6127 c_sum_yi_phi = 0.0_wp
6128
6129# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6130#if defined(MFC_OpenACC)
6131# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6132!$acc loop seq
6133# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6134#elif defined(MFC_OpenMP)
6135# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6136
6137# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6138#endif
6139 do i = eqn_idx%species%beg, eqn_idx%species%end
6140 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
6141 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
6142 end do
6143
6144 call get_mixture_molecular_weight(ys_l, mw_l)
6145 call get_mixture_molecular_weight(ys_r, mw_r)
6146
6147 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
6148 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
6149
6150 r_gas_l = gas_constant/mw_l
6151 r_gas_r = gas_constant/mw_r
6152
6153 t_l = pres_l/rho_l/r_gas_l
6154 t_r = pres_r/rho_r/r_gas_r
6155
6156 call get_species_specific_heats_r(t_l, cp_il)
6157 call get_species_specific_heats_r(t_r, cp_ir)
6158
6159 if (chem_params%gamma_method == 1) then
6160 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
6161 gamma_il = cp_il/(cp_il - 1.0_wp)
6162 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
6163
6164 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
6165 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
6166 else if (chem_params%gamma_method == 2) then
6167 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
6168 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
6169 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
6170 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
6171 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
6172
6173 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
6174 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
6175 end if
6176
6177 call get_mixture_energy_mass(t_l, ys_l, e_l)
6178 call get_mixture_energy_mass(t_r, ys_r, e_r)
6179
6180 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
6181 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
6182 h_l = (e_l + pres_l)/rho_l
6183 h_r = (e_r + pres_r)/rho_r
6184 else
6185 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
6186 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
6187
6188 h_l = (e_l + pres_l)/rho_l
6189 h_r = (e_r + pres_r)/rho_r
6190 end if
6191
6192# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6193 h_l = (e_l + pres_l)/rho_l
6194 h_r = (e_r + pres_r)/rho_r
6195# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6196
6197 if (avg_state == avg_state_roe) then
6198# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6199 rho_avg = sqrt(rho_l*rho_r)
6200# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6201
6202# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6203 vel_avg_rms = 0._wp
6204# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6205
6206# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6207
6208# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6209#if defined(MFC_OpenACC)
6210# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6211!$acc loop seq
6212# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6213#elif defined(MFC_OpenMP)
6214# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6215
6216# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6217#endif
6218# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6219 do i = 1, num_vels
6220# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6221 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
6222# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6223 end do
6224# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6225
6226# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6227 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6228# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6229
6230# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6231 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6232# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6233
6234# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6235 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
6236# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6237
6238# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6239 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6240# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6241
6242# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6243 if (chemistry) then
6244# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6245 eps = 0.001_wp
6246# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6247 call get_species_enthalpies_rt(t_l, h_il)
6248# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6249 call get_species_enthalpies_rt(t_r, h_ir)
6250# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6251 h_il = h_il*gas_constant/molecular_weights*t_l
6252# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6253 h_ir = h_ir*gas_constant/molecular_weights*t_r
6254# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6255 call get_species_specific_heats_r(t_l, cp_il)
6256# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6257 call get_species_specific_heats_r(t_r, cp_ir)
6258# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6259
6260# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6261 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6262# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6263 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6264# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6265 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6266# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6267 if (abs(t_l - t_r) < eps) then
6268# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6269 ! Case when T_L and T_R are very close
6270# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6271 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6272# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6273 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6274# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6275 & - gas_constant/molecular_weights(:)))
6276# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6277 else
6278# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6279 ! Normal calculation when T_L and T_R are sufficiently different
6280# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6281 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6282# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6283 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6284# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6285 end if
6286# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6287 gamma_avg = cp_avg/cv_avg
6288# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6289
6290# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6291 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6292# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6293 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6294# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6295 end if
6296# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6297 end if
6298# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6299
6300# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6301 if (avg_state == avg_state_arithmetic) then
6302# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6303 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6304# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6305 vel_avg_rms = 0._wp
6306# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6307
6308# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6309#if defined(MFC_OpenACC)
6310# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6311!$acc loop seq
6312# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6313#elif defined(MFC_OpenMP)
6314# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6315
6316# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6317#endif
6318# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6319 do i = 1, num_vels
6320# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6321 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6322# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6323 end do
6324# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6325
6326# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6327 h_avg = 5.e-1_wp*(h_l + h_r)
6328# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6329 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6330# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6331 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6332# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6333 end if
6334
6335 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, &
6336 & 0._wp, c_l, qv_l)
6337
6338 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, &
6339 & 0._wp, c_r, qv_r)
6340
6341 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6342 ! variables are placeholders to call the subroutine.
6343 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
6344 & vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
6345
6346 if (viscous) then
6347 if (chemistry) then
6348 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
6349 end if
6350
6351# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6352#if defined(MFC_OpenACC)
6353# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6354!$acc loop seq
6355# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6356#elif defined(MFC_OpenMP)
6357# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6358
6359# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6360#endif
6361 do i = 1, 2
6362 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6363 end do
6364 end if
6365
6366 ! Low Mach correction
6367 if (low_mach == 2) then
6368 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6369# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6370 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6371# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6372 pcorr = 0._wp
6373# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6374
6375# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6376 if (low_mach == 1) then
6377# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6378 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6379# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6380 end if
6381# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6382 else if (riemann_solver == riemann_solver_hllc) then
6383# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6384 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6385# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6386 pcorr = 0._wp
6387# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6388
6389# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6390 if (low_mach == 1) then
6391# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6392 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
6393# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6394 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6395# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6396 else if (low_mach == 2) then
6397# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6398 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6399# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6400 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
6401# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6402 vel_l(dir_idx(1)) = vel_l_tmp
6403# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6404 vel_r(dir_idx(1)) = vel_r_tmp
6405# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6406 end if
6407# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6408 end if
6409 end if
6410
6411 if (wave_speeds == wave_speeds_direct) then
6412# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6413 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6414 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6415 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6416 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
6417 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
6418# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6419 else if (wave_speeds == wave_speeds_pressure) then
6420 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6421
6422 pres_sr = pres_sl
6423
6424 ! Low Mach correction: Thornber et al. JCP (2008)
6425 ms_l = max(1._wp, &
6426 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l &
6427 & - 1._wp)*pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
6428 ms_r = max(1._wp, &
6429 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r &
6430 & - 1._wp)*pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
6431
6432 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6433 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6434
6435 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6436 end if
6437
6438 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6439 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6440
6441 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6442 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6443 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6444 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
6445 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6446 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6447
6448 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6449 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
6450 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
6451
6452 ! Low Mach correction
6453 if (low_mach == 1) then
6454 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6455# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6456 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6457# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6458 pcorr = 0._wp
6459# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6460
6461# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6462 if (low_mach == 1) then
6463# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6464 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6465# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6466 end if
6467# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6468 else if (riemann_solver == riemann_solver_hllc) then
6469# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6470 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6471# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6472 pcorr = 0._wp
6473# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6474
6475# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6476 if (low_mach == 1) then
6477# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6478 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
6479# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6480 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6481# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6482 else if (low_mach == 2) then
6483# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6484 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6485# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6486 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
6487# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6488 vel_l(dir_idx(1)) = vel_l_tmp
6489# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6490 vel_r(dir_idx(1)) = vel_r_tmp
6491# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6492 end if
6493# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6494 end if
6495 else
6496 pcorr = 0._wp
6497 end if
6498
6499# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6500
6501 ! COMPUTING THE HLLC FLUXES MASS FLUX.
6502
6503# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6504#if defined(MFC_OpenACC)
6505# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6506!$acc loop seq
6507# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6508#elif defined(MFC_OpenMP)
6509# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6510
6511# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6512#endif
6513 do i = 1, eqn_idx%cont%end
6514 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6515 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6516 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6517 end do
6518
6519# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6520
6521# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6522#if defined(MFC_OpenACC)
6523# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6524!$acc loop seq
6525# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6526#elif defined(MFC_OpenMP)
6527# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6528
6529# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6530#endif
6531 do i = 1, num_dims
6532 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
6533 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
6534 flux_rsx_vf(j, k, l, &
6535 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
6536 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
6537 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
6538 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
6539 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
6540 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
6541 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
6542 end do
6543
6544 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
6545 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
6546 flux_rsx_vf(j, k, l, &
6547 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
6548 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
6549 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
6550 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
6551 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
6552# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6553
6554 ! VOLUME FRACTION FLUX.
6555
6556# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6557#if defined(MFC_OpenACC)
6558# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6559!$acc loop seq
6560# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6561#elif defined(MFC_OpenMP)
6562# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6563
6564# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6565#endif
6566 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6567 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6568 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6569 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6570 end do
6571
6572 ! VOLUME FRACTION SOURCE FLUX.
6573
6574# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6575#if defined(MFC_OpenACC)
6576# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6577!$acc loop seq
6578# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6579#elif defined(MFC_OpenMP)
6580# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6581
6582# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6583#endif
6584 do i = 1, num_dims
6585 vel_src_rsx_vf(j, k, l, &
6586 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
6587 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
6588 end do
6589
6590 ! COLOR FUNCTION FLUX
6591 if (surface_tension) then
6592 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
6593 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6594 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6595 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6596 end if
6597
6598 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6599
6600 if (chemistry) then
6601
6602# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6603#if defined(MFC_OpenACC)
6604# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6605!$acc loop seq
6606# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6607#elif defined(MFC_OpenMP)
6608# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6609
6610# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6611#endif
6612 do i = eqn_idx%species%beg, eqn_idx%species%end
6613 y_l = ql_prim_rsx_vf(j, k, l, i)
6614 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
6615
6616 flux_rsx_vf(j, k, l, &
6617 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6618 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6619 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
6620 end do
6621 end if
6622
6623# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6624
6625 ! Geometrical source flux for cylindrical coordinates
6626# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6627# 1503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6628 if (cyl_coord) then
6629 ! Substituting the advective flux into the inviscid geometrical source flux
6630
6631# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6632#if defined(MFC_OpenACC)
6633# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6634!$acc loop seq
6635# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6636#elif defined(MFC_OpenMP)
6637# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6638
6639# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6640#endif
6641 do i = 1, eqn_idx%E
6642 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
6643 end do
6644 ! Recalculating the radial momentum geometric source flux
6645 flux_gsrc_rsx_vf(j, k, l, &
6646 & eqn_idx%cont%end + dir_idx(1)) &
6647 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, &
6648 & vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
6649 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
6650 ! Geometrical source of the void fraction(s) is zero
6651
6652# 1516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6653#if defined(MFC_OpenACC)
6654# 1516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6655!$acc loop seq
6656# 1516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6657#elif defined(MFC_OpenMP)
6658# 1516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6659
6660# 1516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6661#endif
6662 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6663 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6664 end do
6665 end if
6666# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6667# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6668# 1538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6669 end do
6670 end do
6671 end do
6672
6673# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6674#if defined(MFC_OpenACC)
6675# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6676!$acc end parallel loop
6677# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6678#elif defined(MFC_OpenMP)
6679# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6680
6681# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6682!$omp end target teams loop
6683# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6684#endif
6685# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6686 end if
6687 end if
6688# 175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6689# 176 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6690# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6691 if (norm_dir == 3) then
6692 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6693 if (model_eqns == model_eqns_6eq) then
6694 ! 6-equation model (model_eqns=3): separate phasic internal energies
6695
6696# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6697
6698# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6699#if defined(MFC_OpenACC)
6700# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6701!$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, &
6702# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6703!$acc& Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, &
6704# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6705!$acc& 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, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, &
6706# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6707!$acc& vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, &
6708# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6709!$acc& xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP) firstprivate(Re_size_loc1, Re_size_loc2)
6710# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6711#elif defined(MFC_OpenMP)
6712# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6713
6714# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6715
6716# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6717
6718# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6719!$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, &
6720# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6721!$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, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, pcorr, zcoef, rho_L, rho_R, &
6722# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6723!$omp& pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, &
6724# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6725!$omp& 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, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, &
6726# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6727!$omp& 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) &
6728# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6729!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
6730# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6731#endif
6732# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6733 do l = is1%beg, is1%end
6734 do k = is2%beg, is2%end
6735 do j = is3%beg, is3%end
6736 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6737 rho_l = 0._wp; rho_r = 0._wp
6738 gamma_l = 0._wp; gamma_r = 0._wp
6739 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6740 qv_l = 0._wp; qv_r = 0._wp
6741 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6742
6743
6744# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6745#if defined(MFC_OpenACC)
6746# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6747!$acc loop seq
6748# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6749#elif defined(MFC_OpenMP)
6750# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6751
6752# 201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6753#endif
6754 do i = 1, num_dims
6755 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6756 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
6757 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6758 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6759 end do
6760
6761 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6762 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
6763
6764 rho_l = 0._wp
6765 gamma_l = 0._wp
6766 pi_inf_l = 0._wp
6767 qv_l = 0._wp
6768
6769 rho_r = 0._wp
6770 gamma_r = 0._wp
6771 pi_inf_r = 0._wp
6772 qv_r = 0._wp
6773
6774 alpha_l_sum = 0._wp
6775 alpha_r_sum = 0._wp
6776
6777 if (mpp_lim) then
6778
6779# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6780#if defined(MFC_OpenACC)
6781# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6782!$acc loop seq
6783# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6784#elif defined(MFC_OpenMP)
6785# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6786
6787# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6788#endif
6789 do i = 1, num_fluids
6790 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6791 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6792 & eqn_idx%E + i)), 1._wp)
6793 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6794 end do
6795
6796
6797# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6798#if defined(MFC_OpenACC)
6799# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6800!$acc loop seq
6801# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6802#elif defined(MFC_OpenMP)
6803# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6804
6805# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6806#endif
6807 do i = 1, num_fluids
6808 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
6809 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
6810 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
6811 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6812 end do
6813
6814
6815# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6816#if defined(MFC_OpenACC)
6817# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6818!$acc loop seq
6819# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6820#elif defined(MFC_OpenMP)
6821# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6822
6823# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6824#endif
6825 do i = 1, num_fluids
6826 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6827 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6828 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
6829 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6830 end do
6831 end if
6832
6833
6834# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6835#if defined(MFC_OpenACC)
6836# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6837!$acc loop seq
6838# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6839#elif defined(MFC_OpenMP)
6840# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6841
6842# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6843#endif
6844 do i = 1, num_fluids
6845 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
6846 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
6847 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6848 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
6849 end do
6850
6851 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
6852 & qv_l)
6853 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
6854 & qv_r)
6855
6856 if (viscous) then
6857 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
6858 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
6859 end if
6860
6861 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6862 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6863
6864 h_l = (e_l + pres_l)/rho_l
6865 h_r = (e_r + pres_r)/rho_r
6866
6867 if (avg_state == avg_state_roe) then
6868# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6869 rho_avg = sqrt(rho_l*rho_r)
6870# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6871
6872# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6873 vel_avg_rms = 0._wp
6874# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6875
6876# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6877
6878# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6879#if defined(MFC_OpenACC)
6880# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6881!$acc loop seq
6882# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6883#elif defined(MFC_OpenMP)
6884# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6885
6886# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6887#endif
6888# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6889 do i = 1, num_vels
6890# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6891 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
6892# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6893 end do
6894# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6895
6896# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6897 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6898# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6899
6900# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6901 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6902# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6903
6904# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6905 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
6906# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6907
6908# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6909 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6910# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6911
6912# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6913 if (chemistry) then
6914# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6915 eps = 0.001_wp
6916# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6917 call get_species_enthalpies_rt(t_l, h_il)
6918# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6919 call get_species_enthalpies_rt(t_r, h_ir)
6920# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6921 h_il = h_il*gas_constant/molecular_weights*t_l
6922# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6923 h_ir = h_ir*gas_constant/molecular_weights*t_r
6924# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6925 call get_species_specific_heats_r(t_l, cp_il)
6926# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6927 call get_species_specific_heats_r(t_r, cp_ir)
6928# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6929
6930# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6931 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6932# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6933 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6934# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6935 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6936# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6937 if (abs(t_l - t_r) < eps) then
6938# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6939 ! Case when T_L and T_R are very close
6940# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6941 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6942# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6943 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6944# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6945 & - gas_constant/molecular_weights(:)))
6946# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6947 else
6948# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6949 ! Normal calculation when T_L and T_R are sufficiently different
6950# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6951 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6952# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6953 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6954# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6955 end if
6956# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6957 gamma_avg = cp_avg/cv_avg
6958# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6959
6960# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6961 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6962# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6963 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6964# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6965 end if
6966# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6967 end if
6968# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6969
6970# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6971 if (avg_state == avg_state_arithmetic) then
6972# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6973 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6974# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6975 vel_avg_rms = 0._wp
6976# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6977
6978# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6979#if defined(MFC_OpenACC)
6980# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6981!$acc loop seq
6982# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6983#elif defined(MFC_OpenMP)
6984# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6985
6986# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6987#endif
6988# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6989 do i = 1, num_vels
6990# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6991 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6992# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6993 end do
6994# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6995
6996# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6997 h_avg = 5.e-1_wp*(h_l + h_r)
6998# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6999 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7000# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7001 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7002# 275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7003 end if
7004
7005 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7006 & c_l, qv_l)
7007
7008 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7009 & c_r, qv_r)
7010
7011 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7012 ! variables are placeholders to call the subroutine.
7013 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7014 & 0._wp, c_avg, qv_avg)
7015
7016 if (viscous) then
7017
7018# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7019#if defined(MFC_OpenACC)
7020# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7021!$acc loop seq
7022# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7023#elif defined(MFC_OpenMP)
7024# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7025
7026# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7027#endif
7028 do i = 1, 2
7029 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7030 end do
7031 end if
7032
7033 ! Low Mach correction
7034 if (low_mach == 2) then
7035 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7036# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7037 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7038# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7039 pcorr = 0._wp
7040# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7041
7042# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7043 if (low_mach == 1) then
7044# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7045 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7046# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7047 end if
7048# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7049 else if (riemann_solver == riemann_solver_hllc) then
7050# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7051 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7052# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7053 pcorr = 0._wp
7054# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7055
7056# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7057 if (low_mach == 1) then
7058# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7059 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
7060# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7061 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7062# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7063 else if (low_mach == 2) then
7064# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7065 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7066# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7067 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
7068# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7069 vel_l(dir_idx(1)) = vel_l_tmp
7070# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7071 vel_r(dir_idx(1)) = vel_r_tmp
7072# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7073 end if
7074# 297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7075 end if
7076 end if
7077
7078 ! COMPUTING THE DIRECT WAVE SPEEDS
7079 if (wave_speeds == wave_speeds_direct) then
7080 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7081 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7082 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7083 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7084 & - rho_r*(s_r - vel_r(dir_idx(1))))
7085 else if (wave_speeds == wave_speeds_pressure) then
7086 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7087
7088 pres_sr = pres_sl
7089
7090 ! Low Mach correction: Thornber et al. JCP (2008)
7091 ms_l = max(1._wp, &
7092 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7093 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7094 ms_r = max(1._wp, &
7095 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7096 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7097
7098 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7099 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7100
7101 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7102 end if
7103
7104 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7105 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7106
7107 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7108 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7109 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7110 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7111 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7112
7113 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7114 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7115 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7116
7117 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7118 xi_mp = -min(0._wp, sign(1._wp, s_l))
7119 xi_pp = max(0._wp, sign(1._wp, s_r))
7120
7121 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 &
7122 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
7123 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7124 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
7125 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7126
7127 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))
7128
7129 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 &
7130 & - vel_r(dir_idx(1)))
7131
7132 ! Low Mach correction
7133 if (low_mach == 1) then
7134 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7135# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7136 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7137# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7138 pcorr = 0._wp
7139# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7140
7141# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7142 if (low_mach == 1) then
7143# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7144 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7145# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7146 end if
7147# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7148 else if (riemann_solver == riemann_solver_hllc) then
7149# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7150 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7151# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7152 pcorr = 0._wp
7153# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7154
7155# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7156 if (low_mach == 1) then
7157# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7158 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
7159# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7160 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7161# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7162 else if (low_mach == 2) then
7163# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7164 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7165# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7166 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
7167# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7168 vel_l(dir_idx(1)) = vel_l_tmp
7169# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7170 vel_r(dir_idx(1)) = vel_r_tmp
7171# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7172 end if
7173# 356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7174 end if
7175 else
7176 pcorr = 0._wp
7177 end if
7178
7179 ! COMPUTING FLUXES MASS FLUX.
7180
7181# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7182#if defined(MFC_OpenACC)
7183# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7184!$acc loop seq
7185# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7186#elif defined(MFC_OpenMP)
7187# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7188
7189# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7190#endif
7191 do i = 1, eqn_idx%cont%end
7192 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7193 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7194 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7195 end do
7196
7197 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7198
7199# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7200#if defined(MFC_OpenACC)
7201# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7202!$acc loop seq
7203# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7204#elif defined(MFC_OpenMP)
7205# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7206
7207# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7208#endif
7209 do i = 1, num_dims
7210 flux_rsx_vf(j, k, l, &
7211 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
7212 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
7213 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
7214 & *dir_flg(dir_idx(i))*pcorr
7215 end do
7216
7217 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7218 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
7219
7220 ! VOLUME FRACTION FLUX.
7221
7222# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7223#if defined(MFC_OpenACC)
7224# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7225!$acc loop seq
7226# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7227#elif defined(MFC_OpenMP)
7228# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7229
7230# 383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7231#endif
7232 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7233 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7234 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
7235 end do
7236
7237 ! Advection velocity source: interface velocity for volume fraction transport
7238
7239# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7240#if defined(MFC_OpenACC)
7241# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7242!$acc loop seq
7243# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7244#elif defined(MFC_OpenMP)
7245# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7246
7247# 390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7248#endif
7249 do i = 1, num_dims
7250 vel_src_rsx_vf(j, k, l, &
7251 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
7252 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
7253 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
7254 end do
7255
7256 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7257 ! energy flux
7258
7259# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7260#if defined(MFC_OpenACC)
7261# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7262!$acc loop seq
7263# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7264#elif defined(MFC_OpenMP)
7265# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7266
7267# 400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7268#endif
7269 do i = 1, num_fluids
7270 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7271 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7272 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7273 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7274 & + pres_r)
7275
7276 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7277 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7278 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7279 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7280 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7281 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7282 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7283 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7284 & i + eqn_idx%adv%beg - 1))
7285 end do
7286
7287 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7288
7289 ! COLOR FUNCTION FLUX
7290 if (surface_tension) then
7291 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7292 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
7293 end if
7294
7295 ! Geometrical source flux for cylindrical coordinates
7296# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7297# 451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7298 if (grid_geometry == 3) then
7299
7300# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7301#if defined(MFC_OpenACC)
7302# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7303!$acc loop seq
7304# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7305#elif defined(MFC_OpenMP)
7306# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7307
7308# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7309#endif
7310 do i = 1, sys_size
7311 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7312 end do
7313 flux_gsrc_rsx_vf(j, k, l, &
7314 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
7315 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
7316
7317 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7318 end if
7319# 463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7320 end do
7321 end do
7322 end do
7323
7324# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7325#if defined(MFC_OpenACC)
7326# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7327!$acc end parallel loop
7328# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7329#elif defined(MFC_OpenMP)
7330# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7331
7332# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7333!$omp end target teams loop
7334# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7335#endif
7336 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
7337 ! 5-equation model with Euler-Euler bubble dynamics
7338
7339# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7340
7341# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7342#if defined(MFC_OpenACC)
7343# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7344!$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, &
7345# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7346!$acc& gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, &
7347# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7348!$acc& vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, &
7349# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7350!$acc& PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) &
7351# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7352!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
7353# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7354#elif defined(MFC_OpenMP)
7355# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7356
7357# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7358
7359# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7360
7361# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7362!$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, &
7363# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7364!$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, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, &
7365# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7366!$omp& E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, &
7367# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7368!$omp& alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, &
7369# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7370!$omp& Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2)
7371# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7372#endif
7373# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7374 do l = is1%beg, is1%end
7375 do k = is2%beg, is2%end
7376 do j = is3%beg, is3%end
7377 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7378 rho_l = 0._wp; rho_r = 0._wp
7379 gamma_l = 0._wp; gamma_r = 0._wp
7380 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7381 qv_l = 0._wp; qv_r = 0._wp
7382
7383
7384# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7385#if defined(MFC_OpenACC)
7386# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7387!$acc loop seq
7388# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7389#elif defined(MFC_OpenMP)
7390# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7391
7392# 487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7393#endif
7394 do i = 1, num_fluids
7395 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7396 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7397 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7398 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7399 end do
7400
7401 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7402
7403
7404# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7405#if defined(MFC_OpenACC)
7406# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7407!$acc loop seq
7408# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7409#elif defined(MFC_OpenMP)
7410# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7411
7412# 497 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7413#endif
7414 do i = 1, num_dims
7415 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7416 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7417 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7418 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7419 end do
7420
7421 ! Retain this in the refactor
7422 if (mpp_lim .and. (num_fluids > 2)) then
7423 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, &
7424 & pi_inf_l, qv_l)
7425 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, &
7426 & pi_inf_r, qv_r)
7427 else if (num_fluids > 2) then
7428 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_l, alpha_l, rho_l, gamma_l, &
7429 & pi_inf_l, qv_l)
7430 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_r, alpha_r, rho_r, gamma_r, &
7431 & pi_inf_r, qv_r)
7432 else
7433 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7434 gamma_l = gammas(1)
7435 pi_inf_l = pi_infs(1)
7436 qv_l = qvs(1)
7437 rho_r = qr_prim_rsx_vf(j, k, l + 1, 1)
7438 gamma_r = gammas(1)
7439 pi_inf_r = pi_infs(1)
7440 qv_r = qvs(1)
7441 end if
7442
7443 if (viscous) then
7444 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7445
7446# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7447#if defined(MFC_OpenACC)
7448# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7449!$acc loop seq
7450# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7451#elif defined(MFC_OpenMP)
7452# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7453
7454# 529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7455#endif
7456 do i = 1, 2
7457 re_l(i) = dflt_real
7458 re_r(i) = dflt_real
7459
7460 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
7461 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
7462
7463
7464# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7465#if defined(MFC_OpenACC)
7466# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7467!$acc loop seq
7468# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7469#elif defined(MFC_OpenMP)
7470# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7471
7472# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7473#endif
7474 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
7475 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7476 & q)))/res_gs(i, q) + re_l(i)
7477 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
7478 & q)))/res_gs(i, q) + re_r(i)
7479 end do
7480
7481 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7482 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7483 end do
7484 end if
7485 end if
7486
7487 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7488 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7489
7490 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7491 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7492
7493 h_l = (e_l + pres_l)/rho_l
7494 h_r = (e_r + pres_r)/rho_r
7495
7496 if (avg_state == avg_state_arithmetic) then
7497
7498# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7499#if defined(MFC_OpenACC)
7500# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7501!$acc loop seq
7502# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7503#elif defined(MFC_OpenMP)
7504# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7505
7506# 561 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7507#endif
7508 do i = 1, nb
7509 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7510 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
7511
7512 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
7513 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
7514 if (.not. polytropic .and. .not. qbmm) then
7515 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
7516 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
7517 end if
7518 end do
7519
7520 if (.not. qbmm) then
7521 if (adv_n) then
7522 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
7523 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
7524 else
7525 nbub_l = 0._wp
7526 nbub_r = 0._wp
7527
7528# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7529#if defined(MFC_OpenACC)
7530# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7531!$acc loop seq
7532# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7533#elif defined(MFC_OpenMP)
7534# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7535
7536# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7537#endif
7538 do i = 1, nb
7539 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
7540 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
7541 end do
7542
7543 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
7544 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
7545 & eqn_idx%E + num_fluids)/nbub_r
7546 end if
7547 else
7548 ! nb stored in 0th moment of first R0 bin in variable conversion module
7549 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
7550 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
7551 end if
7552
7553
7554# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7555#if defined(MFC_OpenACC)
7556# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7557!$acc loop seq
7558# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7559#elif defined(MFC_OpenMP)
7560# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7561
7562# 597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7563#endif
7564 do i = 1, nb
7565 if (.not. qbmm) then
7566 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
7567 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
7568 end if
7569 end do
7570
7571 if (qbmm) then
7572 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
7573 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
7574
7575 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
7576 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
7577
7578 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
7579 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
7580 else
7581 pbwr3lbar = 0._wp
7582 pbwr3rbar = 0._wp
7583
7584 r3lbar = 0._wp
7585 r3rbar = 0._wp
7586
7587 r3v2lbar = 0._wp
7588 r3v2rbar = 0._wp
7589
7590
7591# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7592#if defined(MFC_OpenACC)
7593# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7594!$acc loop seq
7595# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7596#elif defined(MFC_OpenMP)
7597# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7598
7599# 624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7600#endif
7601 do i = 1, nb
7602 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
7603 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
7604
7605 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
7606 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
7607
7608 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
7609 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
7610 end do
7611 end if
7612
7613 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7614 h_avg = 5.e-1_wp*(h_l + h_r)
7615 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7616 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7617 vel_avg_rms = 0._wp
7618
7619
7620# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7621#if defined(MFC_OpenACC)
7622# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7623!$acc loop seq
7624# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7625#elif defined(MFC_OpenMP)
7626# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7627
7628# 643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7629#endif
7630 do i = 1, num_dims
7631 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7632 end do
7633 end if
7634
7635 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7636 & c_l, qv_l)
7637
7638 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7639 & c_r, qv_r)
7640
7641 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7642 ! variables are placeholders to call the subroutine.
7643 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7644 & 0._wp, c_avg, qv_avg)
7645
7646 if (viscous) then
7647
7648# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7649#if defined(MFC_OpenACC)
7650# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7651!$acc loop seq
7652# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7653#elif defined(MFC_OpenMP)
7654# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7655
7656# 661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7657#endif
7658 do i = 1, 2
7659 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7660 end do
7661 end if
7662
7663 ! Low Mach correction
7664 if (low_mach == 2) then
7665 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7666# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7667 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7668# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7669 pcorr = 0._wp
7670# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7671
7672# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7673 if (low_mach == 1) then
7674# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7675 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7676# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7677 end if
7678# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7679 else if (riemann_solver == riemann_solver_hllc) then
7680# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7681 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7682# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7683 pcorr = 0._wp
7684# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7685
7686# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7687 if (low_mach == 1) then
7688# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7689 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
7690# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7691 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7692# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7693 else if (low_mach == 2) then
7694# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7695 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7696# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7697 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
7698# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7699 vel_l(dir_idx(1)) = vel_l_tmp
7700# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7701 vel_r(dir_idx(1)) = vel_r_tmp
7702# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7703 end if
7704# 669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7705 end if
7706 end if
7707
7708 if (wave_speeds == wave_speeds_direct) then
7709 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7710 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7711
7712 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7713 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7714 & - rho_r*(s_r - vel_r(dir_idx(1))))
7715 else if (wave_speeds == wave_speeds_pressure) then
7716 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7717
7718 pres_sr = pres_sl
7719
7720 ! Low Mach correction: Thornber et al. JCP (2008)
7721 ms_l = max(1._wp, &
7722 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7723 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7724 ms_r = max(1._wp, &
7725 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7726 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7727
7728 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7729 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7730
7731 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7732 end if
7733
7734 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7735 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7736
7737 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7738 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7739 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7740 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7741 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7742
7743 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7744 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7745 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7746
7747 ! Low Mach correction
7748 if (low_mach == 1) then
7749 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7750# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7751 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7752# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7753 pcorr = 0._wp
7754# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7755
7756# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7757 if (low_mach == 1) then
7758# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7759 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7760# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7761 end if
7762# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7763 else if (riemann_solver == riemann_solver_hllc) then
7764# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7765 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7766# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7767 pcorr = 0._wp
7768# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7769
7770# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7771 if (low_mach == 1) then
7772# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7773 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
7774# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7775 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7776# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7777 else if (low_mach == 2) then
7778# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7779 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7780# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7781 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
7782# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7783 vel_l(dir_idx(1)) = vel_l_tmp
7784# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7785 vel_r(dir_idx(1)) = vel_r_tmp
7786# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7787 end if
7788# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7789 end if
7790 else
7791 pcorr = 0._wp
7792 end if
7793
7794
7795# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7796#if defined(MFC_OpenACC)
7797# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7798!$acc loop seq
7799# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7800#elif defined(MFC_OpenMP)
7801# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7802
7803# 718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7804#endif
7805 do i = 1, eqn_idx%cont%end
7806 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7807 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7808 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7809 end do
7810
7811 if (bubbles_euler .and. (num_fluids > 1)) then
7812 ! Kill mass transport @ gas density
7813 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
7814 end if
7815
7816 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7817
7818 ! Include p_tilde
7819
7820 if (avg_state == avg_state_arithmetic) then
7821 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
7822 pres_l = pres_l - alpha_l(num_fluids)*pres_l
7823 else
7824 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
7825 end if
7826
7827 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
7828 pres_r = pres_r - alpha_r(num_fluids)*pres_r
7829 else
7830 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
7831 end if
7832 end if
7833
7834
7835# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7836#if defined(MFC_OpenACC)
7837# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7838!$acc loop seq
7839# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7840#elif defined(MFC_OpenMP)
7841# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7842
7843# 748 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7844#endif
7845 do i = 1, num_dims
7846 flux_rsx_vf(j, k, l, &
7847 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
7848 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7849 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
7850 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7851 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7852 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
7853 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7854 end do
7855
7856 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
7857 flux_rsx_vf(j, k, l, &
7858 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
7859 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
7860 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
7861 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
7862 & *pcorr*s_s
7863
7864 ! Volume fraction flux
7865
7866# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7867#if defined(MFC_OpenACC)
7868# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7869!$acc loop seq
7870# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7871#elif defined(MFC_OpenMP)
7872# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7873
7874# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7875#endif
7876 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7877 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7878 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7879 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7880 end do
7881
7882 ! Advection velocity source: interface velocity for volume fraction transport
7883
7884# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7885#if defined(MFC_OpenACC)
7886# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7887!$acc loop seq
7888# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7889#elif defined(MFC_OpenMP)
7890# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7891
7892# 777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7893#endif
7894 do i = 1, num_dims
7895 vel_src_rsx_vf(j, k, l, &
7896 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
7897 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
7898 end do
7899
7900 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7901
7902 ! Add advection flux for bubble variables
7903
7904# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7905#if defined(MFC_OpenACC)
7906# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7907!$acc loop seq
7908# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7909#elif defined(MFC_OpenMP)
7910# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7911
7912# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7913#endif
7914 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7915 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7916 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7917 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7918 end do
7919
7920 if (qbmm) then
7921 flux_rsx_vf(j, k, l, &
7922 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7923 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7924 end if
7925
7926 if (adv_n) then
7927 flux_rsx_vf(j, k, l, &
7928 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7929 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7930 end if
7931
7932 ! Geometrical source flux for cylindrical coordinates
7933# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7934# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7935 if (grid_geometry == 3) then
7936
7937# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7938#if defined(MFC_OpenACC)
7939# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7940!$acc loop seq
7941# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7942#elif defined(MFC_OpenMP)
7943# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7944
7945# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7946#endif
7947 do i = 1, sys_size
7948 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7949 end do
7950
7951 flux_gsrc_rsx_vf(j, k, l, &
7952 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
7953 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
7954 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
7955 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7956 end if
7957# 841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7958 end do
7959 end do
7960 end do
7961
7962# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7963#if defined(MFC_OpenACC)
7964# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7965!$acc end parallel loop
7966# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7967#elif defined(MFC_OpenMP)
7968# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7969
7970# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7971!$omp end target teams loop
7972# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7973#endif
7974# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7975# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7976 else if (hypoelasticity) then
7977# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7978 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
7979 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
7980 ! statement and private variable from the pure-fluid emission, keeping its body and directive
7981 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
7982 ! pinned it at the GPU register ceiling for every HLLC user.
7983# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7984 ! Private list split across _hllc_p1/p2/p3 for Fypp line-length limits
7985# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7986# 860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7987# 861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7988# 862 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7989# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7990 ! The two calls below are identical on purpose. An offload kernel is named
7991 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
7992 ! both emissions the same name; amdflang then launches the wrong one and a
7993 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
7994 ! give two line numbers. Do not merge them back into one.
7995# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7996
7997# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7998
7999# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8000#if defined(MFC_OpenACC)
8001# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8002!$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, &
8003# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8004!$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, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, &
8005# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8006!$acc& gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, &
8007# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8008!$acc& alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, ptilde_L, ptilde_R, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, Yi_avg, &
8009# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8010!$acc& Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R, damage_L, damage_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, &
8011# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8012!$acc& 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, 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, &
8013# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8014!$acc& 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, u_t_HLL_trace, u_t2_HLL_trace, p_face_HLL, tau_qq_face_HLL, tau_nn_HLL, phi, Sigma_L, Sigma_R, &
8015# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8016!$acc& dSigma, Sigma_ref, a_L_ref, a_R_ref, 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) &
8017# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8018!$acc& copyin(is1, is2, is3)
8019# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8020#elif defined(MFC_OpenMP)
8021# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8022
8023# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8024
8025# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8026
8027# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8028!$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, &
8029# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8030!$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, &
8031# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8032!$omp& Cv_L, Cv_R, Cp_avg, Cv_avg, T_avg, eps, 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, &
8033# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8034!$omp& 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, vel_avg_rms, pcorr, zcoef, ptilde_L, ptilde_R, &
8035# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8036!$omp& vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R, damage_L, damage_R, U_L, U_R, F_L, F_R, &
8037# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8038!$omp& 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, tau_nt_L, tau_nt_R, tau_tt_L, tau_tt_R, &
8039# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8040!$omp& 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, u_t2_star, tau_nt2_star, pres_tot_star, &
8041# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8042!$omp& 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, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, &
8043# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8044!$omp& sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, idx_phys) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
8045# 872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8046#endif
8047# 874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8048# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8049 do l = is1%beg, is1%end
8050 do k = is2%beg, is2%end
8051 do j = is3%beg, is3%end
8052 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8053 rho_l = 0._wp; rho_r = 0._wp
8054 gamma_l = 0._wp; gamma_r = 0._wp
8055 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8056 qv_l = 0._wp; qv_r = 0._wp
8057 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8058
8059
8060# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8061#if defined(MFC_OpenACC)
8062# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8063!$acc loop seq
8064# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8065#elif defined(MFC_OpenMP)
8066# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8067
8068# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8069#endif
8070 do i = 1, num_fluids
8071 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8072 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8073 end do
8074
8075
8076# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8077#if defined(MFC_OpenACC)
8078# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8079!$acc loop seq
8080# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8081#elif defined(MFC_OpenMP)
8082# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8083
8084# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8085#endif
8086 do i = 1, num_dims
8087 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8088 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
8089 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8090 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8091 end do
8092
8093 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8094 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
8095
8096# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8097
8098# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8099#if defined(MFC_OpenACC)
8100# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8101!$acc loop seq
8102# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8103#elif defined(MFC_OpenMP)
8104# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8105
8106# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8107#endif
8108 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8109 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8110 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
8111 end do
8112
8113 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
8114 u_n_l = vel_l(dir_idx(1)); u_n_r = vel_r(dir_idx(1))
8115 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
8116 if (n > 0) then
8117 u_t_l = vel_l(dir_idx(2)); u_t_r = vel_r(dir_idx(2))
8118 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
8119 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
8120 end if
8121 if (p > 0) then
8122 u_t2_l = vel_l(dir_idx(3)); u_t2_r = vel_r(dir_idx(3))
8123 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
8124 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
8125 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
8126 end if
8127 pres_tot_l = pres_l - tau_nn_l
8128 pres_tot_r = pres_r - tau_nn_r
8129 if (cyl_coord) then
8130 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
8131 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
8132 else
8133 tau_qq_l = 0._wp
8134 tau_qq_r = 0._wp
8135 end if
8136# 936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8137
8138 ! Change this by splitting it into the cases present in the bubbles_euler
8139 if (mpp_lim) then
8140
8141# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8142#if defined(MFC_OpenACC)
8143# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8144!$acc loop seq
8145# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8146#elif defined(MFC_OpenMP)
8147# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8148
8149# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8150#endif
8151 do i = 1, num_fluids
8152 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8153 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8154 & eqn_idx%E + i)), 1._wp)
8155 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
8156 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
8157 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
8158 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8159 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8160 end do
8161
8162
8163# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8164#if defined(MFC_OpenACC)
8165# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8166!$acc loop seq
8167# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8168#elif defined(MFC_OpenMP)
8169# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8170
8171# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8172#endif
8173 do i = 1, num_fluids
8174 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8175 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8176 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
8177 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8178 end do
8179 end if
8180
8181 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
8182 ! downstream
8183
8184# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8185#if defined(MFC_OpenACC)
8186# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8187!$acc loop seq
8188# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8189#elif defined(MFC_OpenMP)
8190# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8191
8192# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8193#endif
8194 do i = 1, num_fluids
8195 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
8196 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
8197 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8198 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8199 end do
8200
8201 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
8202 & pi_inf_l, qv_l)
8203 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
8204 & pi_inf_r, qv_r)
8205
8206 if (viscous) then
8207 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
8208 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
8209 end if
8210
8211 if (chemistry) then
8212 c_sum_yi_phi = 0.0_wp
8213
8214# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8215#if defined(MFC_OpenACC)
8216# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8217!$acc loop seq
8218# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8219#elif defined(MFC_OpenMP)
8220# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8221
8222# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8223#endif
8224 do i = eqn_idx%species%beg, eqn_idx%species%end
8225 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8226 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
8227 end do
8228
8229 call get_mixture_molecular_weight(ys_l, mw_l)
8230 call get_mixture_molecular_weight(ys_r, mw_r)
8231
8232 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8233 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8234
8235 r_gas_l = gas_constant/mw_l
8236 r_gas_r = gas_constant/mw_r
8237
8238 t_l = pres_l/rho_l/r_gas_l
8239 t_r = pres_r/rho_r/r_gas_r
8240
8241 call get_species_specific_heats_r(t_l, cp_il)
8242 call get_species_specific_heats_r(t_r, cp_ir)
8243
8244 if (chem_params%gamma_method == 1) then
8245 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8246 gamma_il = cp_il/(cp_il - 1.0_wp)
8247 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8248
8249 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8250 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8251 else if (chem_params%gamma_method == 2) then
8252 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8253 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8254 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8255 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8256 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8257
8258 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8259 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8260 end if
8261
8262 call get_mixture_energy_mass(t_l, ys_l, e_l)
8263 call get_mixture_energy_mass(t_r, ys_r, e_r)
8264
8265 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8266 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8267 h_l = (e_l + pres_l)/rho_l
8268 h_r = (e_r + pres_r)/rho_r
8269 else
8270 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8271 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8272
8273 h_l = (e_l + pres_l)/rho_l
8274 h_r = (e_r + pres_r)/rho_r
8275 end if
8276
8277# 1037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8278 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8279
8280# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8281#if defined(MFC_OpenACC)
8282# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8283!$acc loop seq
8284# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8285#elif defined(MFC_OpenMP)
8286# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8287
8288# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8289#endif
8290 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8291 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8292 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
8293 end do
8294 damage_l = 0._wp; damage_r = 0._wp
8295 if (cont_damage) then
8296 damage_l = ql_prim_rsx_vf(j, k, l, eqn_idx%damage)
8297 damage_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%damage)
8298 end if
8299
8300 call s_compute_hypoelastic_interface_energy(num_fluids, alpha_l, alpha_r, damage_l, &
8301 & damage_r, tau_e_l, tau_e_r, g_l, g_r, e_l, e_r)
8302 ! The acoustic EOS sound speed is based on thermal/kinetic enthalpy. The
8303 ! hypoelastic stress energy remains in E_L/E_R for the conservative state,
8304 ! but must not inflate the base acoustic sound speed used below, so H_L/H_R
8305 ! keep their pre-adjustment values here.
8306# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8307
8308 if (avg_state == avg_state_roe) then
8309# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8310 rho_avg = sqrt(rho_l*rho_r)
8311# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8312
8313# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8314 vel_avg_rms = 0._wp
8315# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8316
8317# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8318
8319# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8320#if defined(MFC_OpenACC)
8321# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8322!$acc loop seq
8323# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8324#elif defined(MFC_OpenMP)
8325# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8326
8327# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8328#endif
8329# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8330 do i = 1, num_vels
8331# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8332 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
8333# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8334 end do
8335# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8336
8337# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8338 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8339# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8340
8341# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8342 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8343# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8344
8345# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8346 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
8347# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8348
8349# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8350 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8351# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8352
8353# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8354 if (chemistry) then
8355# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8356 eps = 0.001_wp
8357# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8358 call get_species_enthalpies_rt(t_l, h_il)
8359# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8360 call get_species_enthalpies_rt(t_r, h_ir)
8361# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8362 h_il = h_il*gas_constant/molecular_weights*t_l
8363# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8364 h_ir = h_ir*gas_constant/molecular_weights*t_r
8365# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8366 call get_species_specific_heats_r(t_l, cp_il)
8367# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8368 call get_species_specific_heats_r(t_r, cp_ir)
8369# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8370
8371# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8372 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8373# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8374 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8375# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8376 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8377# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8378 if (abs(t_l - t_r) < eps) then
8379# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8380 ! Case when T_L and T_R are very close
8381# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8382 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8383# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8384 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8385# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8386 & - gas_constant/molecular_weights(:)))
8387# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8388 else
8389# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8390 ! Normal calculation when T_L and T_R are sufficiently different
8391# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8392 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8393# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8394 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8395# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8396 end if
8397# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8398 gamma_avg = cp_avg/cv_avg
8399# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8400
8401# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8402 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8403# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8404 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8405# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8406 end if
8407# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8408 end if
8409# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8410
8411# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8412 if (avg_state == avg_state_arithmetic) then
8413# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8414 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8415# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8416 vel_avg_rms = 0._wp
8417# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8418
8419# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8420#if defined(MFC_OpenACC)
8421# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8422!$acc loop seq
8423# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8424#elif defined(MFC_OpenMP)
8425# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8426
8427# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8428#endif
8429# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8430 do i = 1, num_vels
8431# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8432 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8433# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8434 end do
8435# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8436
8437# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8438 h_avg = 5.e-1_wp*(h_l + h_r)
8439# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8440 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8441# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8442 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8443# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8444 end if
8445
8446 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, &
8447 & 0._wp, c_l, qv_l)
8448
8449 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, &
8450 & 0._wp, c_r, qv_r)
8451
8452 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8453 ! variables are placeholders to call the subroutine.
8454 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
8455 & vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
8456
8457 if (viscous) then
8458 if (chemistry) then
8459 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8460 end if
8461
8462# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8463#if defined(MFC_OpenACC)
8464# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8465!$acc loop seq
8466# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8467#elif defined(MFC_OpenMP)
8468# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8469
8470# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8471#endif
8472 do i = 1, 2
8473 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8474 end do
8475 end if
8476
8477 ! Low Mach correction
8478 if (low_mach == 2) then
8479 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8480# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8481 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8482# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8483 pcorr = 0._wp
8484# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8485
8486# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8487 if (low_mach == 1) then
8488# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8489 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8490# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8491 end if
8492# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8493 else if (riemann_solver == riemann_solver_hllc) then
8494# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8495 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8496# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8497 pcorr = 0._wp
8498# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8499
8500# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8501 if (low_mach == 1) then
8502# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8503 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
8504# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8505 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8506# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8507 else if (low_mach == 2) then
8508# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8509 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8510# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8511 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
8512# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8513 vel_l(dir_idx(1)) = vel_l_tmp
8514# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8515 vel_r(dir_idx(1)) = vel_r_tmp
8516# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8517 end if
8518# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8519 end if
8520 end if
8521
8522 if (wave_speeds == wave_speeds_direct) then
8523# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8524 ! Elastic wave speed, Rodriguez et al. JCP (2019)
8525 s_l = min(vel_l(dir_idx(1)) - sqrt(max(verysmall, c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l)), &
8526# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8527 & vel_r(dir_idx(1)) - sqrt(max(verysmall, c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r)))
8528# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8529 s_r = max(vel_r(dir_idx(1)) + sqrt(max(verysmall, c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r)), &
8530# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8531 & vel_l(dir_idx(1)) + sqrt(max(verysmall, c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l)))
8532 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
8533 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
8534 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
8535 & - vel_r(dir_idx(1))))
8536# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8537 else if (wave_speeds == wave_speeds_pressure) then
8538 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8539
8540 pres_sr = pres_sl
8541
8542 ! Low Mach correction: Thornber et al. JCP (2008)
8543 ms_l = max(1._wp, &
8544 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l &
8545 & - 1._wp)*pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8546 ms_r = max(1._wp, &
8547 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r &
8548 & - 1._wp)*pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8549
8550 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8551 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8552
8553 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8554 end if
8555
8556 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8557 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8558
8559 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8560 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8561 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8562 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
8563 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8564 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8565
8566 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8567 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8568 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8569
8570 ! Low Mach correction
8571 if (low_mach == 1) then
8572 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8573# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8574 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8575# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8576 pcorr = 0._wp
8577# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8578
8579# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8580 if (low_mach == 1) then
8581# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8582 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8583# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8584 end if
8585# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8586 else if (riemann_solver == riemann_solver_hllc) then
8587# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8588 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8589# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8590 pcorr = 0._wp
8591# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8592
8593# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8594 if (low_mach == 1) then
8595# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8596 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
8597# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8598 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8599# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8600 else if (low_mach == 2) then
8601# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8602 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8603# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8604 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
8605# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8606 vel_l(dir_idx(1)) = vel_l_tmp
8607# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8608 vel_r(dir_idx(1)) = vel_r_tmp
8609# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8610 end if
8611# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8612 end if
8613 else
8614 pcorr = 0._wp
8615 end if
8616
8617# 1144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8618 if (n == 0) then
8619 u_t_l = 0._wp; u_t_r = 0._wp
8620 tau_nt_l = 0._wp; tau_nt_r = 0._wp
8621 end if
8622 if (p == 0) then
8623 u_t2_l = 0._wp; u_t2_r = 0._wp
8624 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
8625 end if
8626 a_l = rho_l*(s_l - vel_l(dir_idx(1)))
8627 a_r = rho_r*(s_r - vel_r(dir_idx(1)))
8628 denom_a = a_r - a_l
8629 u_t_star = (a_r*u_t_r - a_l*u_t_l + (tau_nt_r - tau_nt_l))/(denom_a + sgm_eps)
8630 tau_nt_star = (a_r*tau_nt_r - a_l*tau_nt_l)/(denom_a + sgm_eps)
8631 u_t2_star = (a_r*u_t2_r - a_l*u_t2_l + (tau_nt2_r - tau_nt2_l))/(denom_a + sgm_eps)
8632 tau_nt2_star = (a_r*tau_nt2_r - a_l*tau_nt2_l)/(denom_a + sgm_eps)
8633 pres_tot_star = pres_tot_l + a_l*(s_s - vel_l(dir_idx(1)))
8634# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8635
8636 ! COMPUTING THE HLLC FLUXES MASS FLUX.
8637
8638# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8639#if defined(MFC_OpenACC)
8640# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8641!$acc loop seq
8642# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8643#elif defined(MFC_OpenMP)
8644# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8645
8646# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8647#endif
8648 do i = 1, eqn_idx%cont%end
8649 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8650 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8651 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8652 end do
8653
8654# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8655 flux_rsx_vf(j, k, l, &
8656 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
8657 & *vel_l(dir_idx(1)) + s_m*(xi_l*s_s - vel_l(dir_idx(1)))) + pres_tot_l) &
8658 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) + s_p*(xi_r*s_s &
8659 & - vel_r(dir_idx(1)))) + pres_tot_r) + (s_m/s_l)*(s_p/s_r)*pcorr
8660 if (n > 0) then
8661 flux_rsx_vf(j, k, l, &
8662 & eqn_idx%cont%end + dir_idx(2)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t_l &
8663 & + s_m*(xi_l*u_t_star - u_t_l)) - tau_nt_l) &
8664 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t_r + s_p*(xi_r*u_t_star - u_t_r)) &
8665 & - tau_nt_r)
8666 end if
8667 if (p > 0) then
8668 flux_rsx_vf(j, k, l, &
8669 & eqn_idx%cont%end + dir_idx(3)) = xi_m*(rho_l*(vel_l(dir_idx(1))*u_t2_l &
8670 & + s_m*(xi_l*u_t2_star - u_t2_l)) - tau_nt2_l) &
8671 & + xi_p*(rho_r*(vel_r(dir_idx(1))*u_t2_r + s_p*(xi_r*u_t2_star - u_t2_r)) &
8672 & - tau_nt2_r)
8673 end if
8674
8675 flux_rsx_vf(j, k, l, &
8676 & eqn_idx%E) = xi_m*((e_l + pres_tot_l)*vel_l(dir_idx(1)) - u_t_l*tau_nt_l &
8677 & - u_t2_l*tau_nt2_l + s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s &
8678 & + pres_tot_l/(s_l - vel_l(dir_idx(1)))) + (u_t_l*tau_nt_l &
8679 & - u_t_star*tau_nt_star)/(s_l - vel_l(dir_idx(1))) + (u_t2_l*tau_nt2_l &
8680 & - u_t2_star*tau_nt2_star)/(s_l - vel_l(dir_idx(1)))) - e_l)) + xi_p*((e_r &
8681 & + pres_tot_r)*vel_r(dir_idx(1)) - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r &
8682 & + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_tot_r/(s_r &
8683 & - vel_r(dir_idx(1)))) + (u_t_r*tau_nt_r - u_t_star*tau_nt_star)/(s_r &
8684 & - vel_r(dir_idx(1))) + (u_t2_r*tau_nt2_r - u_t2_star*tau_nt2_star)/(s_r &
8685 & - vel_r(dir_idx(1)))) - e_r)) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
8686
8687 if (n == 0) then
8688 flux_rsx_vf(j, k, l, &
8689 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
8690 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
8691 & + s_p*(xi_r - 1._wp))
8692 else if (p == 0) then
8693 if (dir_idx(1) == 1) then
8694 flux_rsx_vf(j, k, l, &
8695 & eqn_idx%stress%beg) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
8696 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
8697 & + s_p*(xi_r - 1._wp))
8698 flux_rsx_vf(j, k, l, &
8699 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
8700 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
8701 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
8702 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
8703 flux_rsx_vf(j, k, l, &
8704 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
8705 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
8706 & + s_p*(xi_r - 1._wp))
8707 else
8708 flux_rsx_vf(j, k, l, &
8709 & eqn_idx%stress%beg + 2) = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) &
8710 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) &
8711 & + s_p*(xi_r - 1._wp))
8712 flux_rsx_vf(j, k, l, &
8713 & eqn_idx%stress%beg + 1) = xi_m*(rho_l*vel_l(dir_idx(1))*tau_nt_l &
8714 & + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
8715 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r &
8716 & + s_p*(rho_r*xi_r*tau_nt_star - rho_r*tau_nt_r))
8717 flux_rsx_vf(j, k, l, &
8718 & eqn_idx%stress%beg) = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) &
8719 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) &
8720 & + s_p*(xi_r - 1._wp))
8721 end if
8722 else
8723 flux_rsx_vf(j, k, l, &
8724 & eqn_idx%stress%beg - 1 + stress_perm(1)) &
8725 & = xi_m*rho_l*tau_nn_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8726 & + xi_p*rho_r*tau_nn_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8727 flux_rsx_vf(j, k, l, &
8728 & eqn_idx%stress%beg - 1 + stress_perm(2)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
8729 & *tau_nt_l + s_m*(rho_l*xi_l*tau_nt_star - rho_l*tau_nt_l)) &
8730 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt_r + s_p*(rho_r*xi_r*tau_nt_star &
8731 & - rho_r*tau_nt_r))
8732 flux_rsx_vf(j, k, l, &
8733 & eqn_idx%stress%beg - 1 + stress_perm(4)) = xi_m*(rho_l*vel_l(dir_idx(1)) &
8734 & *tau_nt2_l + s_m*(rho_l*xi_l*tau_nt2_star - rho_l*tau_nt2_l)) &
8735 & + xi_p*(rho_r*vel_r(dir_idx(1))*tau_nt2_r &
8736 & + s_p*(rho_r*xi_r*tau_nt2_star - rho_r*tau_nt2_r))
8737 flux_rsx_vf(j, k, l, &
8738 & eqn_idx%stress%beg - 1 + stress_perm(3)) &
8739 & = xi_m*rho_l*tau_tt_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8740 & + xi_p*rho_r*tau_tt_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8741 flux_rsx_vf(j, k, l, &
8742 & eqn_idx%stress%beg - 1 + stress_perm(6)) &
8743 & = xi_m*rho_l*tau_t2t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8744 & + xi_p*rho_r*tau_t2t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8745 flux_rsx_vf(j, k, l, &
8746 & eqn_idx%stress%beg - 1 + stress_perm(5)) &
8747 & = xi_m*rho_l*tau_t1t2_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8748 & + xi_p*rho_r*tau_t1t2_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8749 end if
8750 if (cyl_coord) then
8751 flux_rsx_vf(j, k, l, &
8752 & eqn_idx%stress%end) = xi_m*rho_l*tau_qq_l*(vel_l(dir_idx(1)) &
8753 & + s_m*(xi_l - 1._wp)) + xi_p*rho_r*tau_qq_r*(vel_r(dir_idx(1)) &
8754 & + s_p*(xi_r - 1._wp))
8755 end if
8756
8757 if (s_l >= 0._wp) then
8758 u_n_hllc = vel_l(dir_idx(1)); u_t_hllc = u_t_l; u_t2_hllc = u_t2_l
8759 else if (s_r <= 0._wp) then
8760 u_n_hllc = vel_r(dir_idx(1)); u_t_hllc = u_t_r; u_t2_hllc = u_t2_r
8761 else
8762 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
8763 end if
8764 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
8765 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
8766 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
8767# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8768
8769 ! VOLUME FRACTION FLUX.
8770
8771# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8772#if defined(MFC_OpenACC)
8773# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8774!$acc loop seq
8775# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8776#elif defined(MFC_OpenMP)
8777# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8778
8779# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8780#endif
8781 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8782 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8783 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8784 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8785 end do
8786
8787 ! VOLUME FRACTION SOURCE FLUX.
8788
8789# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8790#if defined(MFC_OpenACC)
8791# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8792!$acc loop seq
8793# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8794#elif defined(MFC_OpenMP)
8795# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8796
8797# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8798#endif
8799 do i = 1, num_dims
8800 vel_src_rsx_vf(j, k, l, &
8801 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8802 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8803 end do
8804
8805 ! COLOR FUNCTION FLUX
8806 if (surface_tension) then
8807 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
8808 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8809 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8810 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8811 end if
8812
8813 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8814
8815 if (chemistry) then
8816
8817# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8818#if defined(MFC_OpenACC)
8819# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8820!$acc loop seq
8821# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8822#elif defined(MFC_OpenMP)
8823# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8824
8825# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8826#endif
8827 do i = eqn_idx%species%beg, eqn_idx%species%end
8828 y_l = ql_prim_rsx_vf(j, k, l, i)
8829 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
8830
8831 flux_rsx_vf(j, k, l, &
8832 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8833 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8834 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
8835 end do
8836 end if
8837
8838# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8839 ! HLLC-ADC blending for hypoelasticity
8840 if (riemann_hypo_adc) then
8841 ! Build U_L, U_R and F_L, F_R in local-basis layout
8842
8843# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8844#if defined(MFC_OpenACC)
8845# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8846!$acc loop seq
8847# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8848#elif defined(MFC_OpenMP)
8849# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8850
8851# 1351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8852#endif
8853 do i = 1, num_fluids
8854 u_l(i) = alpha_rho_l(i)
8855 u_r(i) = alpha_rho_r(i)
8856 u_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)
8857 u_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)
8858 f_l(i) = alpha_rho_l(i)*u_n_l
8859 f_r(i) = alpha_rho_r(i)*u_n_r
8860 f_l(eqn_idx%adv%beg - 1 + i) = alpha_l(i)*u_n_l
8861 f_r(eqn_idx%adv%beg - 1 + i) = alpha_r(i)*u_n_r
8862 end do
8863
8864 ! Momentum U/F in physical order via dir_idx
8865 u_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l
8866 u_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r
8867 f_l(eqn_idx%cont%end + dir_idx(1)) = rho_l*u_n_l*u_n_l + pres_tot_l
8868 f_r(eqn_idx%cont%end + dir_idx(1)) = rho_r*u_n_r*u_n_r + pres_tot_r
8869 if (n > 0) then
8870 u_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_t_l
8871 u_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_t_r
8872 f_l(eqn_idx%cont%end + dir_idx(2)) = rho_l*u_n_l*u_t_l - tau_nt_l
8873 f_r(eqn_idx%cont%end + dir_idx(2)) = rho_r*u_n_r*u_t_r - tau_nt_r
8874 end if
8875 if (p > 0) then
8876 u_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_t2_l
8877 u_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_t2_r
8878 f_l(eqn_idx%cont%end + dir_idx(3)) = rho_l*u_n_l*u_t2_l - tau_nt2_l
8879 f_r(eqn_idx%cont%end + dir_idx(3)) = rho_r*u_n_r*u_t2_r - tau_nt2_r
8880 end if
8881
8882 u_l(eqn_idx%E) = e_l
8883 u_r(eqn_idx%E) = e_r
8884 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
8885 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
8886
8887 ! Stress U/F in physical order via stress_perm: U = rho*tau, F = rho*u_n*tau
8888
8889# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8890#if defined(MFC_OpenACC)
8891# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8892!$acc loop seq
8893# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8894#elif defined(MFC_OpenMP)
8895# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8896
8897# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8898#endif
8899 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 - merge(1, 0, cyl_coord)
8900 idx_phys = eqn_idx%stress%beg - 1 + stress_perm(i)
8901 u_l(idx_phys) = rho_l*tau_e_l(stress_perm(i))
8902 u_r(idx_phys) = rho_r*tau_e_r(stress_perm(i))
8903 f_l(idx_phys) = rho_l*u_n_l*tau_e_l(stress_perm(i))
8904 f_r(idx_phys) = rho_r*u_n_r*tau_e_r(stress_perm(i))
8905 end do
8906 if (cyl_coord) then
8907 u_l(eqn_idx%stress%end) = rho_l*tau_qq_l
8908 u_r(eqn_idx%stress%end) = rho_r*tau_qq_r
8909 f_l(eqn_idx%stress%end) = rho_l*u_n_l*tau_qq_l
8910 f_r(eqn_idx%stress%end) = rho_r*u_n_r*tau_qq_r
8911 end if
8912
8913 ! Compute F_HLL (physical order) and HLL trace velocities
8914 if (s_l >= 0._wp) then
8915
8916# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8917#if defined(MFC_OpenACC)
8918# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8919!$acc loop seq
8920# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8921#elif defined(MFC_OpenMP)
8922# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8923
8924# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8925#endif
8926 do i = 1, sys_size
8927 f_hll(i) = f_l(i)
8928 end do
8929 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l; u_t2_hll_trace = u_t2_l
8930 else if (s_r <= 0._wp) then
8931
8932# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8933#if defined(MFC_OpenACC)
8934# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8935!$acc loop seq
8936# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8937#elif defined(MFC_OpenMP)
8938# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8939
8940# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8941#endif
8942 do i = 1, sys_size
8943 f_hll(i) = f_r(i)
8944 end do
8945 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r; u_t2_hll_trace = u_t2_r
8946 else
8947
8948# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8949#if defined(MFC_OpenACC)
8950# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8951!$acc loop seq
8952# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8953#elif defined(MFC_OpenMP)
8954# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8955
8956# 1416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8957#endif
8958 do i = 1, sys_size
8959 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 &
8960 & + verysmall)
8961 end do
8962 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
8963 u_t_hll_trace = 0._wp; u_t2_hll_trace = 0._wp
8964 if (n > 0) u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
8965 if (p > 0) u_t2_hll_trace = (s_r*u_t2_l - s_l*u_t2_r)/(s_r - s_l + verysmall)
8966 end if
8967
8968 ! ADC sensor
8969 sigma_l = pres_tot_l
8970 sigma_r = pres_tot_r
8971 dsigma = sigma_r - sigma_l
8972 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
8973
8974 a_l_ref = sqrt(max(verysmall, c_l*c_l + ((4._wp/3._wp)*g_l + tau_nn_l)/rho_l))
8975 a_r_ref = sqrt(max(verysmall, c_r*c_r + ((4._wp/3._wp)*g_r + tau_nn_r)/rho_r))
8976 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
8977
8978 du_t = u_t_r - u_t_l
8979 dtau_nt = tau_nt_r - tau_nt_l
8980 du_t2 = u_t2_r - u_t2_l
8981 dtau_nt2 = tau_nt2_r - tau_nt2_l
8982
8983 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
8984 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
8985 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 &
8986 & + verysmall)
8987
8988 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
8989 phi = exp(-(sensor_combined**adc_power))
8990
8991 ! Blend all flux components: F_HLL is in physical order
8992
8993# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8994#if defined(MFC_OpenACC)
8995# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8996!$acc loop seq
8997# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8998#elif defined(MFC_OpenMP)
8999# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9000
9001# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9002#endif
9003 do i = 1, sys_size
9004 flux_rsx_vf(j, k, l, i) = f_hll(i) + phi*(flux_rsx_vf(j, k, l, i) - f_hll(i))
9005 end do
9006
9007 ! Blend interface velocities (scalar HLL traces)
9008 u_n_hllc = u_n_hll_trace + phi*(u_n_hllc - u_n_hll_trace)
9009 u_t_hllc = u_t_hll_trace + phi*(u_t_hllc - u_t_hll_trace)
9010 u_t2_hllc = u_t2_hll_trace + phi*(u_t2_hllc - u_t2_hll_trace)
9011
9012 ! Overwrite vel_src with blended velocities
9013 vel_src_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
9014 if (n > 0) vel_src_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
9015 if (p > 0) vel_src_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
9016
9017 ! Update advection source flux with ADC-blended face-normal velocity
9018 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = u_n_hllc
9019
9020 ! Overwrite nc_iface_vel with blended velocities
9021 nc_iface_vel_rsx_vf(j, k, l, dir_idx(1)) = u_n_hllc
9022 if (n > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(2)) = u_t_hllc
9023 if (p > 0) nc_iface_vel_rsx_vf(j, k, l, dir_idx(3)) = u_t2_hllc
9024 end if
9025 ! END HLLC-ADC
9026# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9027
9028 ! Geometrical source flux for cylindrical coordinates
9029# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9030# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9031 if (grid_geometry == 3) then
9032
9033# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9034#if defined(MFC_OpenACC)
9035# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9036!$acc loop seq
9037# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9038#elif defined(MFC_OpenMP)
9039# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9040
9041# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9042#endif
9043 do i = 1, sys_size
9044 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
9045 end do
9046
9047 flux_gsrc_rsx_vf(j, k, l, &
9048 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
9049 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
9050 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
9051 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, &
9052 & eqn_idx%mom%beg + 1)
9053 end if
9054# 1538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9055 end do
9056 end do
9057 end do
9058
9059# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9060#if defined(MFC_OpenACC)
9061# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9062!$acc end parallel loop
9063# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9064#elif defined(MFC_OpenMP)
9065# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9066
9067# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9068!$omp end target teams loop
9069# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9070#endif
9071# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9072# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9073 else
9074# 851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9075 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection. Emitted twice --
9076 ! once specialized for hypoelasticity, once pure-fluid. The #:if HYPO guards strip every hypoelastic
9077 ! statement and private variable from the pure-fluid emission, keeping its body and directive
9078 ! identical to the single kernel a build without hypoelasticity would compile. Sharing one kernel
9079 ! pinned it at the GPU register ceiling for every HLLC user.
9080# 863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9081 ! Master's pure-fluid private list, unchanged
9082# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9083# 866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9084 ! The two calls below are identical on purpose. An offload kernel is named
9085 ! after the .fpp line of its GPU_PARALLEL_LOOP, so one shared call would give
9086 ! both emissions the same name; amdflang then launches the wrong one and a
9087 ! hypoelastic run faults inside the pure-fluid kernel. Two call sites are what
9088 ! give two line numbers. Do not merge them back into one.
9089# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9090
9091# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9092
9093# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9094#if defined(MFC_OpenACC)
9095# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9096!$acc parallel loop collapse(3) gang vector default(present) private(i, 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, &
9097# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9098!$acc& alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, &
9099# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9100!$acc& 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, vel_avg_rms, pcorr, zcoef, &
9101# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9102!$acc& vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
9103# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9104#elif defined(MFC_OpenMP)
9105# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9106
9107# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9108
9109# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9110
9111# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9112!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, T_L, T_R, &
9113# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9114!$omp& vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, &
9115# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9116!$omp& Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, xi_L_m1, xi_R_m1, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, &
9117# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9118!$omp& 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, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, &
9119# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9120!$omp& Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2) firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
9121# 875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9122#endif
9123# 877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9124# 878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9125 do l = is1%beg, is1%end
9126 do k = is2%beg, is2%end
9127 do j = is3%beg, is3%end
9128 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9129 rho_l = 0._wp; rho_r = 0._wp
9130 gamma_l = 0._wp; gamma_r = 0._wp
9131 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9132 qv_l = 0._wp; qv_r = 0._wp
9133 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9134
9135
9136# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9137#if defined(MFC_OpenACC)
9138# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9139!$acc loop seq
9140# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9141#elif defined(MFC_OpenMP)
9142# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9143
9144# 888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9145#endif
9146 do i = 1, num_fluids
9147 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
9148 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
9149 end do
9150
9151
9152# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9153#if defined(MFC_OpenACC)
9154# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9155!$acc loop seq
9156# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9157#elif defined(MFC_OpenMP)
9158# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9159
9160# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9161#endif
9162 do i = 1, num_dims
9163 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
9164 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
9165 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9166 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9167 end do
9168
9169 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
9170 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
9171
9172# 936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9173
9174 ! Change this by splitting it into the cases present in the bubbles_euler
9175 if (mpp_lim) then
9176
9177# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9178#if defined(MFC_OpenACC)
9179# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9180!$acc loop seq
9181# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9182#elif defined(MFC_OpenMP)
9183# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9184
9185# 939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9186#endif
9187 do i = 1, num_fluids
9188 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
9189 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
9190 & eqn_idx%E + i)), 1._wp)
9191 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
9192 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
9193 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
9194 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
9195 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
9196 end do
9197
9198
9199# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9200#if defined(MFC_OpenACC)
9201# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9202!$acc loop seq
9203# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9204#elif defined(MFC_OpenMP)
9205# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9206
9207# 951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9208#endif
9209 do i = 1, num_fluids
9210 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
9211 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
9212 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
9213 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
9214 end do
9215 end if
9216
9217 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
9218 ! downstream
9219
9220# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9221#if defined(MFC_OpenACC)
9222# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9223!$acc loop seq
9224# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9225#elif defined(MFC_OpenMP)
9226# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9227
9228# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9229#endif
9230 do i = 1, num_fluids
9231 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
9232 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
9233 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
9234 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
9235 end do
9236
9237 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
9238 & pi_inf_l, qv_l)
9239 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
9240 & pi_inf_r, qv_r)
9241
9242 if (viscous) then
9243 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
9244 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
9245 end if
9246
9247 if (chemistry) then
9248 c_sum_yi_phi = 0.0_wp
9249
9250# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9251#if defined(MFC_OpenACC)
9252# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9253!$acc loop seq
9254# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9255#elif defined(MFC_OpenMP)
9256# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9257
9258# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9259#endif
9260 do i = eqn_idx%species%beg, eqn_idx%species%end
9261 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
9262 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
9263 end do
9264
9265 call get_mixture_molecular_weight(ys_l, mw_l)
9266 call get_mixture_molecular_weight(ys_r, mw_r)
9267
9268 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
9269 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
9270
9271 r_gas_l = gas_constant/mw_l
9272 r_gas_r = gas_constant/mw_r
9273
9274 t_l = pres_l/rho_l/r_gas_l
9275 t_r = pres_r/rho_r/r_gas_r
9276
9277 call get_species_specific_heats_r(t_l, cp_il)
9278 call get_species_specific_heats_r(t_r, cp_ir)
9279
9280 if (chem_params%gamma_method == 1) then
9281 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
9282 gamma_il = cp_il/(cp_il - 1.0_wp)
9283 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
9284
9285 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
9286 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
9287 else if (chem_params%gamma_method == 2) then
9288 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
9289 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
9290 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
9291 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
9292 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
9293
9294 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
9295 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
9296 end if
9297
9298 call get_mixture_energy_mass(t_l, ys_l, e_l)
9299 call get_mixture_energy_mass(t_r, ys_r, e_r)
9300
9301 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
9302 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
9303 h_l = (e_l + pres_l)/rho_l
9304 h_r = (e_r + pres_r)/rho_r
9305 else
9306 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
9307 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
9308
9309 h_l = (e_l + pres_l)/rho_l
9310 h_r = (e_r + pres_r)/rho_r
9311 end if
9312
9313# 1056 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9314 h_l = (e_l + pres_l)/rho_l
9315 h_r = (e_r + pres_r)/rho_r
9316# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9317
9318 if (avg_state == avg_state_roe) then
9319# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9320 rho_avg = sqrt(rho_l*rho_r)
9321# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9322
9323# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9324 vel_avg_rms = 0._wp
9325# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9326
9327# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9328
9329# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9330#if defined(MFC_OpenACC)
9331# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9332!$acc loop seq
9333# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9334#elif defined(MFC_OpenMP)
9335# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9336
9337# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9338#endif
9339# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9340 do i = 1, num_vels
9341# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9342 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
9343# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9344 end do
9345# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9346
9347# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9348 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
9349# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9350
9351# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9352 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
9353# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9354
9355# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9356 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
9357# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9358
9359# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9360 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
9361# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9362
9363# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9364 if (chemistry) then
9365# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9366 eps = 0.001_wp
9367# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9368 call get_species_enthalpies_rt(t_l, h_il)
9369# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9370 call get_species_enthalpies_rt(t_r, h_ir)
9371# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9372 h_il = h_il*gas_constant/molecular_weights*t_l
9373# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9374 h_ir = h_ir*gas_constant/molecular_weights*t_r
9375# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9376 call get_species_specific_heats_r(t_l, cp_il)
9377# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9378 call get_species_specific_heats_r(t_r, cp_ir)
9379# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9380
9381# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9382 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9383# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9384 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9385# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9386 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9387# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9388 if (abs(t_l - t_r) < eps) then
9389# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9390 ! Case when T_L and T_R are very close
9391# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9392 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9393# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9394 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
9395# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9396 & - gas_constant/molecular_weights(:)))
9397# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9398 else
9399# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9400 ! Normal calculation when T_L and T_R are sufficiently different
9401# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9402 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9403# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9404 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9405# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9406 end if
9407# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9408 gamma_avg = cp_avg/cv_avg
9409# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9410
9411# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9412 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9413# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9414 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9415# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9416 end if
9417# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9418 end if
9419# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9420
9421# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9422 if (avg_state == avg_state_arithmetic) then
9423# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9424 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9425# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9426 vel_avg_rms = 0._wp
9427# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9428
9429# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9430#if defined(MFC_OpenACC)
9431# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9432!$acc loop seq
9433# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9434#elif defined(MFC_OpenMP)
9435# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9436
9437# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9438#endif
9439# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9440 do i = 1, num_vels
9441# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9442 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9443# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9444 end do
9445# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9446
9447# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9448 h_avg = 5.e-1_wp*(h_l + h_r)
9449# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9450 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9451# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9452 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9453# 1060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9454 end if
9455
9456 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, &
9457 & 0._wp, c_l, qv_l)
9458
9459 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, &
9460 & 0._wp, c_r, qv_r)
9461
9462 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9463 ! variables are placeholders to call the subroutine.
9464 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
9465 & vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
9466
9467 if (viscous) then
9468 if (chemistry) then
9469 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
9470 end if
9471
9472# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9473#if defined(MFC_OpenACC)
9474# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9475!$acc loop seq
9476# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9477#elif defined(MFC_OpenMP)
9478# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9479
9480# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9481#endif
9482 do i = 1, 2
9483 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9484 end do
9485 end if
9486
9487 ! Low Mach correction
9488 if (low_mach == 2) then
9489 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
9490# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9491 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9492# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9493 pcorr = 0._wp
9494# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9495
9496# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9497 if (low_mach == 1) then
9498# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9499 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9500# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9501 end if
9502# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9503 else if (riemann_solver == riemann_solver_hllc) then
9504# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9505 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9506# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9507 pcorr = 0._wp
9508# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9509
9510# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9511 if (low_mach == 1) then
9512# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9513 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
9514# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9515 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9516# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9517 else if (low_mach == 2) then
9518# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9519 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9520# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9521 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
9522# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9523 vel_l(dir_idx(1)) = vel_l_tmp
9524# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9525 vel_r(dir_idx(1)) = vel_r_tmp
9526# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9527 end if
9528# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9529 end if
9530 end if
9531
9532 if (wave_speeds == wave_speeds_direct) then
9533# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9534 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9535 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9536 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9537 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9538 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9539# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9540 else if (wave_speeds == wave_speeds_pressure) then
9541 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9542
9543 pres_sr = pres_sl
9544
9545 ! Low Mach correction: Thornber et al. JCP (2008)
9546 ms_l = max(1._wp, &
9547 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l &
9548 & - 1._wp)*pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9549 ms_r = max(1._wp, &
9550 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r &
9551 & - 1._wp)*pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9552
9553 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9554 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9555
9556 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9557 end if
9558
9559 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9560 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9561
9562 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9563 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9564 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9565 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
9566 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9567 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9568
9569 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9570 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9571 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9572
9573 ! Low Mach correction
9574 if (low_mach == 1) then
9575 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
9576# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9577 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9578# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9579 pcorr = 0._wp
9580# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9581
9582# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9583 if (low_mach == 1) then
9584# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9585 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9586# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9587 end if
9588# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9589 else if (riemann_solver == riemann_solver_hllc) then
9590# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9591 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9592# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9593 pcorr = 0._wp
9594# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9595
9596# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9597 if (low_mach == 1) then
9598# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9599 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
9600# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9601 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9602# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9603 else if (low_mach == 2) then
9604# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9605 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9606# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9607 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
9608# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9609 vel_l(dir_idx(1)) = vel_l_tmp
9610# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9611 vel_r(dir_idx(1)) = vel_r_tmp
9612# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9613 end if
9614# 1138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9615 end if
9616 else
9617 pcorr = 0._wp
9618 end if
9619
9620# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9621
9622 ! COMPUTING THE HLLC FLUXES MASS FLUX.
9623
9624# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9625#if defined(MFC_OpenACC)
9626# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9627!$acc loop seq
9628# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9629#elif defined(MFC_OpenMP)
9630# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9631
9632# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9633#endif
9634 do i = 1, eqn_idx%cont%end
9635 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9636 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
9637 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9638 end do
9639
9640# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9641
9642# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9643#if defined(MFC_OpenACC)
9644# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9645!$acc loop seq
9646# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9647#elif defined(MFC_OpenMP)
9648# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9649
9650# 1284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9651#endif
9652 do i = 1, num_dims
9653 ! MOMENTUM FLUX. identity: xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i =
9654 ! (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
9655 flux_rsx_vf(j, k, l, &
9656 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
9657 & *vel_l(dir_idx(i)) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp &
9658 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i)) &
9659 & *(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
9660 & + s_p*(dir_flg(dir_idx(i))*s_r + (1._wp - dir_flg(dir_idx(i))) &
9661 & *vel_r(dir_idx(i)))*xi_r_m1) + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l) &
9662 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9663 end do
9664
9665 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9666 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
9667 flux_rsx_vf(j, k, l, &
9668 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 &
9669 & + xi_l*(s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1) &
9670 & ))))) + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 &
9671 & + xi_r*(s_s - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1) &
9672 & ))))) + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
9673# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9674
9675 ! VOLUME FRACTION FLUX.
9676
9677# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9678#if defined(MFC_OpenACC)
9679# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9680!$acc loop seq
9681# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9682#elif defined(MFC_OpenMP)
9683# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9684
9685# 1309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9686#endif
9687 do i = eqn_idx%adv%beg, eqn_idx%adv%end
9688 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9689 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
9690 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9691 end do
9692
9693 ! VOLUME FRACTION SOURCE FLUX.
9694
9695# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9696#if defined(MFC_OpenACC)
9697# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9698!$acc loop seq
9699# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9700#elif defined(MFC_OpenMP)
9701# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9702
9703# 1317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9704#endif
9705 do i = 1, num_dims
9706 vel_src_rsx_vf(j, k, l, &
9707 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
9708 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
9709 end do
9710
9711 ! COLOR FUNCTION FLUX
9712 if (surface_tension) then
9713 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
9714 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9715 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
9716 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9717 end if
9718
9719 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9720
9721 if (chemistry) then
9722
9723# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9724#if defined(MFC_OpenACC)
9725# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9726!$acc loop seq
9727# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9728#elif defined(MFC_OpenMP)
9729# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9730
9731# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9732#endif
9733 do i = eqn_idx%species%beg, eqn_idx%species%end
9734 y_l = ql_prim_rsx_vf(j, k, l, i)
9735 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
9736
9737 flux_rsx_vf(j, k, l, &
9738 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9739 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9740 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9741 end do
9742 end if
9743
9744# 1476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9745
9746 ! Geometrical source flux for cylindrical coordinates
9747# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9748# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9749 if (grid_geometry == 3) then
9750
9751# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9752#if defined(MFC_OpenACC)
9753# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9754!$acc loop seq
9755# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9756#elif defined(MFC_OpenMP)
9757# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9758
9759# 1525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9760#endif
9761 do i = 1, sys_size
9762 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
9763 end do
9764
9765 flux_gsrc_rsx_vf(j, k, l, &
9766 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
9767 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
9768 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
9769 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, &
9770 & eqn_idx%mom%beg + 1)
9771 end if
9772# 1538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9773 end do
9774 end do
9775 end do
9776
9777# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9778#if defined(MFC_OpenACC)
9779# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9780!$acc end parallel loop
9781# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9782#elif defined(MFC_OpenMP)
9783# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9784
9785# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9786!$omp end target teams loop
9787# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9788#endif
9789# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9790 end if
9791 end if
9792# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9793 ! Computing HLLC flux and source flux for Euler system of equations
9794
9795 if (viscous) then
9796 if (weno_re_flux) then
9797 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9798 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9799 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9800 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9801 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9802 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9803 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9804 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
9805 & norm_dir, ix, iy, iz)
9806 else
9807 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9808 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9809 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9810 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9811 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9812 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9813 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9814 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
9815 & norm_dir, ix, iy, iz)
9816 end if
9817 end if
9818
9819 if (surface_tension) then
9820 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
9821 end if
9822
9823 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
9824
9825 end subroutine s_hllc_riemann_solver
9826
9827end 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:323
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:360
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:360
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:360
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged model.
Definition m_bubbles.fpp.f90:323
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:608
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:335
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:376
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:139
m_constants::avg_state_roe
integer, parameter avg_state_roe
Definition m_constants.fpp.f90:127
m_constants::wave_speeds_direct
integer, parameter wave_speeds_direct
Definition m_constants.fpp.f90:160
m_constants::riemann_solver_hll
integer, parameter riemann_solver_hll
Definition m_constants.fpp.f90:153
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:154
m_constants::wave_speeds_pressure
integer, parameter wave_speeds_pressure
Definition m_constants.fpp.f90:161
m_constants::riemann_solver_lax_friedrichs
integer, parameter riemann_solver_lax_friedrichs
Definition m_constants.fpp.f90:156
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:128
m_constants::model_eqns_6eq
integer, parameter model_eqns_6eq
Definition m_constants.fpp.f90:140
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:334
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:377
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:855
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:744
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:746
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:856
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:745
m_global_parameters::stress_perm
integer, dimension(6) stress_perm
Full tensor permutation: local basis -> physical storage index.
Definition m_global_parameters.fpp.f90:747
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:839
m_riemann_solver_hllc
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solver_hllc.fpp.f90:347
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:335
m_riemann_state::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_state.fpp.f90:348
m_riemann_state::isz
type(int_bounds_info) isz
Definition m_riemann_state.fpp.f90:478
m_riemann_state::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_state.fpp.f90:449
m_riemann_state::isx
type(int_bounds_info) isx
Definition m_riemann_state.fpp.f90:478
m_riemann_state::is3
type(int_bounds_info) is3
Definition m_riemann_state.fpp.f90:477
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:348
m_riemann_state::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_state.fpp.f90:506
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:1630
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:526
m_riemann_state::nc_iface_vel_rsx_vf
real(wp), dimension(:,:,:,:), allocatable nc_iface_vel_rsx_vf
Definition m_riemann_state.fpp.f90:378
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:548
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:2760
m_riemann_state::isy
type(int_bounds_info) isy
Definition m_riemann_state.fpp.f90:478
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:2863
m_riemann_state::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_state.fpp.f90:436
m_riemann_state::is2
type(int_bounds_info) is2
Definition m_riemann_state.fpp.f90:477
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:2923
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:2671
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:365
m_riemann_state::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_state.fpp.f90:462
m_riemann_state::s_accumulate_mixture_properties
subroutine s_accumulate_mixture_properties(nf, alpha_rho_k, alpha_k, rho_k, gamma_k, pi_inf_k, qv_k)
Accumulate the mixture density, specific heat ratio function, liquid stiffness function,...
Definition m_riemann_state.fpp.f90:2601
m_riemann_state::is1
type(int_bounds_info) is1
Definition m_riemann_state.fpp.f90:477
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:337
m_surface_tension::s_compute_capillary_source_flux
subroutine, public s_compute_capillary_source_flux(vsrc_rsx_vf, flux_src_vf, id, isx, isy, isz)
Compute the capillary source flux from reconstructed color-gradient fields.
Definition m_surface_tension.fpp.f90:601
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_variables_conversion::s_compute_speed_of_sound
subroutine, public s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state ...
Definition m_variables_conversion.fpp.f90:2530
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:417
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:337