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! New line at end of file is required for FYPP
45# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
46# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
47# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
48# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71! New line at end of file is required for FYPP
72# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
73
74# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150! New line at end of file is required for FYPP
151# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
152# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
153# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
154# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177! New line at end of file is required for FYPP
178# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
179
180# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235! New line at end of file is required for FYPP
236# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
237
238! GPU parallel region (scalar reductions, maxval/minval)
239# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! GPU parallel loop over threads (most common GPU macro)
242# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Required closing for GPU_PARALLEL_LOOP
245# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Mark routine for device compilation
248# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Declare device-resident data
251# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Inner loop within a GPU parallel region
254# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Scoped GPU data region
257# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Host code with device pointers (for MPI with GPU buffers)
260# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Allocate device memory (unscoped)
263# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Free device memory
266# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Atomic operation on device
269# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! End atomic capture block
272# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Copy data between host and device
275# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Synchronization barrier
278# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Import GPU library module (openacc or omp_lib)
281# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Emit code only for AMD compiler
284# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Emit code for non-Cray compilers
287# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Emit code only for Cray compiler
290# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Emit code for non-NVIDIA compilers
293# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
296# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297! New line at end of file is required for FYPP
298# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
299
300# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
301
302! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
303! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
304! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
305# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Allocate and create GPU device memory
308# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310! Free GPU device memory and deallocate
311# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Cray-specific GPU pointer setup for vector fields
314# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Cray-specific GPU pointer setup for scalar fields
317# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for acoustic source spatials
320# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323
324# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325! New line at end of file is required for FYPP
326# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
327# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
328# 13 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
329
330# 60 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
331
332# 70 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
333
334# 94 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
335# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
336
337module m_riemann_solver_hllc
338
339 use m_derived_types
340 use m_global_parameters
341 use m_variables_conversion
342 use m_bubbles
343 use m_constants, only: riemann_solver_hll, riemann_solver_hllc, riemann_solver_lax_friedrichs, model_eqns_5eq, &
344 & model_eqns_6eq, model_eqns_4eq, avg_state_roe, avg_state_arithmetic, wave_speeds_direct, wave_speeds_pressure
345 use m_bubbles_ee
346 use m_surface_tension
347 use m_chemistry
348 use m_thermochem, only: gas_constant, get_mixture_molecular_weight, get_mixture_specific_heat_cv_mass, &
349 & get_mixture_energy_mass, get_species_specific_heats_r, get_species_enthalpies_rt, get_mixture_specific_heat_cp_mass, &
350 & molecular_weights
351 use m_riemann_state
352
353 implicit none
354
355contains
356
357 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
358 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
359
360 & 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, &
361 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
362
363 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
364 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
365 type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf
366 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
367 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
368
369 ! Intercell fluxes
370 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
371 integer, intent(in) :: norm_dir
372 type(int_bounds_info), intent(in) :: ix, iy, iz
373
374# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
375 real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R
376 real(wp), dimension(num_fluids) :: alpha_L, alpha_R
377 real(wp), dimension(num_dims) :: vel_L, vel_R
378# 56 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
379
380 real(wp) :: rho_L, rho_R
381 real(wp) :: pres_L, pres_R
382 real(wp) :: E_L, E_R
383 real(wp) :: H_L, H_R
384# 65 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
385 real(wp), dimension(num_species) :: Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR
386 real(wp), dimension(num_species) :: Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2
387# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
388 real(wp) :: Cp_avg, Cv_avg, T_avg, c_sum_Yi_Phi, eps
389 real(wp) :: T_L, T_R
390 real(wp) :: MW_L, MW_R
391 real(wp) :: R_gas_L, R_gas_R
392 real(wp) :: Cp_L, Cp_R
393 real(wp) :: Cv_L, Cv_R
394 real(wp) :: Gamm_L, Gamm_R
395 real(wp) :: Y_L, Y_R
396 real(wp) :: gamma_L, gamma_R
397 real(wp) :: pi_inf_L, pi_inf_R
398 real(wp) :: qv_L, qv_R
399 real(wp) :: c_L, c_R
400 real(wp), dimension(2) :: Re_L, Re_R
401 real(wp) :: rho_avg
402 real(wp) :: H_avg
403 real(wp) :: gamma_avg
404 real(wp) :: qv_avg
405 real(wp) :: c_avg
406 real(wp) :: s_L, s_R, s_M, s_P, s_S
407 real(wp) :: xi_L, xi_R !< Left and right wave speeds functions
408 real(wp) :: xi_L_m1, xi_R_m1 !< xi_L/R - 1, computed without cancellation
409 real(wp) :: xi_M, xi_P
410 real(wp) :: xi_MP, xi_PP
411# 97 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
412 real(wp), dimension(nb) :: R0_L, R0_R
413 real(wp), dimension(nb) :: V0_L, V0_R
414 real(wp), dimension(nb) :: P0_L, P0_R
415 real(wp), dimension(nb) :: pbw_L, pbw_R
416# 102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
417
418 real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L, nbub_R
419 real(wp) :: ptilde_L, ptilde_R
420 real(wp) :: PbwR3Lbar, PbwR3Rbar
421 real(wp) :: R3Lbar, R3Rbar
422 real(wp) :: R3V2Lbar, R3V2Rbar
423 real(wp), dimension(6) :: tau_e_L, tau_e_R
424# 112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
425 real(wp), dimension(num_dims) :: xi_field_L, xi_field_R
426# 114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
427 real(wp) :: G_L, G_R
428 real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms
429 real(wp) :: vel_L_tmp, vel_R_tmp
430 real(wp) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_star
431 real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R
432 real(wp) :: flux_ene_e
433 real(wp) :: zcoef, pcorr !< low Mach number correction
434 integer :: Re_max, i, j, k, l, q !< Generic loop iterators
435 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
436
437 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
438 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
439
440 ! Reshaping inputted data based on dimensional splitting direction
441
442 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
443
444# 135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
445# 136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
446# 137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
447 if (norm_dir == 1) then
448 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
449 if (model_eqns == model_eqns_6eq) then
450 ! 6-equation model (model_eqns=3): separate phasic internal energies
451
452# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
453
454# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
455#if defined(MFC_OpenACC)
456# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
457!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP)
458# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
459#elif defined(MFC_OpenMP)
460# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
461
462# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
463
464# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
465
466# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
467!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP)
468# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
469#endif
470# 151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
471 do l = is3%beg, is3%end
472 do k = is2%beg, is2%end
473 do j = is1%beg, is1%end
474 vel_l_rms = 0._wp; vel_r_rms = 0._wp
475 rho_l = 0._wp; rho_r = 0._wp
476 gamma_l = 0._wp; gamma_r = 0._wp
477 pi_inf_l = 0._wp; pi_inf_r = 0._wp
478 qv_l = 0._wp; qv_r = 0._wp
479 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
480
481
482# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
483#if defined(MFC_OpenACC)
484# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
485!$acc loop seq
486# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
487#elif defined(MFC_OpenMP)
488# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
489
490# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
491#endif
492 do i = 1, num_dims
493 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
494 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
495 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
496 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
497 end do
498
499 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
500 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
501
502 rho_l = 0._wp
503 gamma_l = 0._wp
504 pi_inf_l = 0._wp
505 qv_l = 0._wp
506
507 rho_r = 0._wp
508 gamma_r = 0._wp
509 pi_inf_r = 0._wp
510 qv_r = 0._wp
511
512 alpha_l_sum = 0._wp
513 alpha_r_sum = 0._wp
514
515 if (mpp_lim) then
516
517# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
518#if defined(MFC_OpenACC)
519# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
520!$acc loop seq
521# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
522#elif defined(MFC_OpenMP)
523# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
524
525# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
526#endif
527 do i = 1, num_fluids
528 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
529 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
530 & eqn_idx%E + i)), 1._wp)
531 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
532 end do
533
534
535# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
536#if defined(MFC_OpenACC)
537# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
538!$acc loop seq
539# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
540#elif defined(MFC_OpenMP)
541# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
542
543# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
544#endif
545 do i = 1, num_fluids
546 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
547 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
548 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
549 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
550 end do
551
552
553# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
554#if defined(MFC_OpenACC)
555# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
556!$acc loop seq
557# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
558#elif defined(MFC_OpenMP)
559# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
560
561# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
562#endif
563 do i = 1, num_fluids
564 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
565 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
566 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
567 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
568 end do
569 end if
570
571
572# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
573#if defined(MFC_OpenACC)
574# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
575!$acc loop seq
576# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
577#elif defined(MFC_OpenMP)
578# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
579
580# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
581#endif
582 do i = 1, num_fluids
583 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
584 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
585 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
586 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
587
588 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
589 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
590 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
591 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
592
593 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
594 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
595 end do
596
597 if (viscous) then
598
599# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
600#if defined(MFC_OpenACC)
601# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
602!$acc loop seq
603# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
604#elif defined(MFC_OpenMP)
605# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
606
607# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
608#endif
609 do i = 1, 2
610 re_l(i) = dflt_real
611 re_r(i) = dflt_real
612 if (re_size(i) > 0) re_l(i) = 0._wp
613 if (re_size(i) > 0) re_r(i) = 0._wp
614
615# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
616#if defined(MFC_OpenACC)
617# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
618!$acc loop seq
619# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
620#elif defined(MFC_OpenMP)
621# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
622
623# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
624#endif
625 do q = 1, re_size(i)
626 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
627 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
628 & q) + re_r(i)
629 end do
630 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
631 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
632 end do
633 end if
634
635 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
636 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
637
638 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
639 if (hypoelasticity) then
640
641# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
642#if defined(MFC_OpenACC)
643# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
644!$acc loop seq
645# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
646#elif defined(MFC_OpenMP)
647# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
648
649# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
650#endif
651 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
652 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
653 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
654 end do
655 g_l = 0._wp; g_r = 0._wp
656
657# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
658#if defined(MFC_OpenACC)
659# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
660!$acc loop seq
661# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
662#elif defined(MFC_OpenMP)
663# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
664
665# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
666#endif
667 do i = 1, num_fluids
668 g_l = g_l + alpha_l(i)*gs_rs(i)
669 g_r = g_r + alpha_r(i)*gs_rs(i)
670 end do
671
672# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
673#if defined(MFC_OpenACC)
674# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
675!$acc loop seq
676# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
677#elif defined(MFC_OpenMP)
678# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
679
680# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
681#endif
682 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
683 ! Elastic contribution to energy if G large enough
684 if ((g_l > verysmall) .and. (g_r > verysmall)) then
685 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
686 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
687 ! Additional terms in 2D and 3D
688 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
689 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
690 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
691 end if
692 end if
693 end do
694 end if
695
696 ! Hyperelastic stress contribution: strain energy added to total energy
697 if (hyperelasticity) then
698
699# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
700#if defined(MFC_OpenACC)
701# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
702!$acc loop seq
703# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
704#elif defined(MFC_OpenMP)
705# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
706
707# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
708#endif
709 do i = 1, num_dims
710 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
711 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
712 end do
713 g_l = 0._wp; g_r = 0._wp
714
715# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
716#if defined(MFC_OpenACC)
717# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
718!$acc loop seq
719# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
720#elif defined(MFC_OpenMP)
721# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
722
723# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
724#endif
725 do i = 1, num_fluids
726 ! Mixture left and right shear modulus
727 g_l = g_l + alpha_l(i)*gs_rs(i)
728 g_r = g_r + alpha_r(i)*gs_rs(i)
729 end do
730 ! Elastic contribution to energy if G large enough
731 if (g_l > verysmall .and. g_r > verysmall) then
732 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
733 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
734 end if
735
736# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
737#if defined(MFC_OpenACC)
738# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
739!$acc loop seq
740# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
741#elif defined(MFC_OpenMP)
742# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
743
744# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
745#endif
746 do i = 1, b_size - 1
747 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
748 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
749 end do
750 end if
751
752 h_l = (e_l + pres_l)/rho_l
753 h_r = (e_r + pres_r)/rho_r
754
755 if (avg_state == avg_state_roe) then
756# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
757 rho_avg = sqrt(rho_l*rho_r)
758# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
759
760# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
761 vel_avg_rms = 0._wp
762# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
763
764# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
765
766# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
767#if defined(MFC_OpenACC)
768# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
769!$acc loop seq
770# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
771#elif defined(MFC_OpenMP)
772# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
773
774# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
775#endif
776# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
777 do i = 1, num_vels
778# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
779 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
780# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
781 end do
782# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
783
784# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
785 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
786# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
787
788# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
789 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
790# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
791
792# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
793 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
794# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
795
796# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
797 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
798# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
799
800# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
801 if (chemistry) then
802# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
803 eps = 0.001_wp
804# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
805 call get_species_enthalpies_rt(t_l, h_il)
806# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
807 call get_species_enthalpies_rt(t_r, h_ir)
808# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
809 h_il = h_il*gas_constant/molecular_weights*t_l
810# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
811 h_ir = h_ir*gas_constant/molecular_weights*t_r
812# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
813 call get_species_specific_heats_r(t_l, cp_il)
814# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
815 call get_species_specific_heats_r(t_r, cp_ir)
816# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
817
818# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
819 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
820# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
821 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
822# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
823 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
824# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
825 if (abs(t_l - t_r) < eps) then
826# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
827 ! Case when T_L and T_R are very close
828# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
829 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
830# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
831 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
832# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
833 & - gas_constant/molecular_weights(:)))
834# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
835 else
836# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
837 ! Normal calculation when T_L and T_R are sufficiently different
838# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
839 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
840# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
841 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
842# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
843 end if
844# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
845 gamma_avg = cp_avg/cv_avg
846# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
847
848# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
849 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
850# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
851 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
852# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
853 end if
854# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
855 end if
856# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
857
858# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
859 if (avg_state == avg_state_arithmetic) then
860# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
861 rho_avg = 5.e-1_wp*(rho_l + rho_r)
862# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
863 vel_avg_rms = 0._wp
864# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
865
866# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
867#if defined(MFC_OpenACC)
868# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
869!$acc loop seq
870# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
871#elif defined(MFC_OpenMP)
872# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
873
874# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
875#endif
876# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
877 do i = 1, num_vels
878# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
879 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
880# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
881 end do
882# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
883
884# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
885 h_avg = 5.e-1_wp*(h_l + h_r)
886# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
887 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
888# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
889 qv_avg = 5.e-1_wp*(qv_l + qv_r)
890# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
891 end if
892
893 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
894 & c_l, qv_l)
895
896 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
897 & c_r, qv_r)
898
899 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
900 ! variables are placeholders to call the subroutine.
901 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
902 & 0._wp, c_avg, qv_avg)
903
904 if (viscous) then
905
906# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
907#if defined(MFC_OpenACC)
908# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
909!$acc loop seq
910# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
911#elif defined(MFC_OpenMP)
912# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
913
914# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
915#endif
916 do i = 1, 2
917 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
918 end do
919 end if
920
921 ! Low Mach correction
922 if (low_mach == 2) then
923 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
924# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
925 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
926# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
927 pcorr = 0._wp
928# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
929
930# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
931 if (low_mach == 1) then
932# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
933 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
934# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
935 end if
936# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
937 else if (riemann_solver == riemann_solver_hllc) then
938# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
939 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
940# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
941 pcorr = 0._wp
942# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
943
944# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
945 if (low_mach == 1) then
946# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
947 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))) &
948# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
949 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
950# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
951 else if (low_mach == 2) then
952# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
953 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))))
954# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
955 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))))
956# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
957 vel_l(dir_idx(1)) = vel_l_tmp
958# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
959 vel_r(dir_idx(1)) = vel_r_tmp
960# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
961 end if
962# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
963 end if
964 end if
965
966 ! COMPUTING THE DIRECT WAVE SPEEDS
967 if (wave_speeds == wave_speeds_direct) then
968 if (elasticity) then
969 ! Elastic wave speed, Rodriguez et al. JCP (2019)
970 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
971 & ))/rho_l), &
972 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
973 & + tau_e_r(dir_idx_tau(1)))/rho_r))
974 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
975 & ))/rho_r), &
976 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
977 & + tau_e_l(dir_idx_tau(1)))/rho_l))
978 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
979 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
980 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
981 & - vel_r(dir_idx(1))))
982 else
983 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
984 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
985 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
986 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
987 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
988 end if
989 else if (wave_speeds == wave_speeds_pressure) then
990 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
991
992 pres_sr = pres_sl
993
994 ! Low Mach correction: Thornber et al. JCP (2008)
995 ms_l = max(1._wp, &
996 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
997 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
998 ms_r = max(1._wp, &
999 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1000 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1001
1002 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1003 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1004
1005 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1006 end if
1007
1008 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1009 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1010
1011 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1012 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1013 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1014 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1015 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1016
1017 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1018 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
1019 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
1020
1021 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
1022 xi_mp = -min(0._wp, sign(1._wp, s_l))
1023 xi_pp = max(0._wp, sign(1._wp, s_r))
1024
1025 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 &
1026 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
1027 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
1028 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
1029 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
1030
1031 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))
1032
1033 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 &
1034 & - vel_r(dir_idx(1)))
1035
1036 ! Low Mach correction
1037 if (low_mach == 1) then
1038 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
1039# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1040 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1041# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1042 pcorr = 0._wp
1043# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1044
1045# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1046 if (low_mach == 1) then
1047# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1048 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1049# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1050 end if
1051# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1052 else if (riemann_solver == riemann_solver_hllc) then
1053# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1054 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1055# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1056 pcorr = 0._wp
1057# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1058
1059# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1060 if (low_mach == 1) then
1061# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1062 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))) &
1063# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1064 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1065# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1066 else if (low_mach == 2) then
1067# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1068 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))))
1069# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1070 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))))
1071# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1072 vel_l(dir_idx(1)) = vel_l_tmp
1073# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1074 vel_r(dir_idx(1)) = vel_r_tmp
1075# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1076 end if
1077# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1078 end if
1079 else
1080 pcorr = 0._wp
1081 end if
1082
1083 ! COMPUTING FLUXES MASS FLUX.
1084
1085# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1086#if defined(MFC_OpenACC)
1087# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1088!$acc loop seq
1089# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1090#elif defined(MFC_OpenMP)
1091# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1092
1093# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1094#endif
1095 do i = 1, eqn_idx%cont%end
1096 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1097 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1098 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1099 end do
1100
1101 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1102
1103# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1104#if defined(MFC_OpenACC)
1105# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1106!$acc loop seq
1107# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1108#elif defined(MFC_OpenMP)
1109# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1110
1111# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1112#endif
1113 do i = 1, num_dims
1114 flux_rsx_vf(j, k, l, &
1115 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
1116 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
1117 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
1118 & *dir_flg(dir_idx(i))*pcorr
1119 end do
1120
1121 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
1122 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
1123
1124 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
1125 if (elasticity) then
1126 flux_ene_e = 0._wp
1127
1128# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1129#if defined(MFC_OpenACC)
1130# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1131!$acc loop seq
1132# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1133#elif defined(MFC_OpenMP)
1134# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1135
1136# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1137#endif
1138 do i = 1, num_dims
1139 ! MOMENTUM ELASTIC FLUX.
1140 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
1141 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
1142 & - xi_p*tau_e_r(dir_idx_tau(i))
1143 ! ENERGY ELASTIC FLUX.
1144 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
1145 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
1146 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
1147 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
1148 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
1149 end do
1150 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
1151 end if
1152
1153 ! VOLUME FRACTION FLUX.
1154
1155# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1156#if defined(MFC_OpenACC)
1157# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1158!$acc loop seq
1159# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1160#elif defined(MFC_OpenMP)
1161# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1162
1163# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1164#endif
1165 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1166 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1167 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
1168 end do
1169
1170 ! Advection velocity source: interface velocity for volume fraction transport
1171
1172# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1173#if defined(MFC_OpenACC)
1174# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1175!$acc loop seq
1176# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1177#elif defined(MFC_OpenMP)
1178# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1179
1180# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1181#endif
1182 do i = 1, num_dims
1183 vel_src_rsx_vf(j, k, l, &
1184 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1185 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
1186 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
1187 end do
1188
1189 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
1190 ! energy flux
1191
1192# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1193#if defined(MFC_OpenACC)
1194# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1195!$acc loop seq
1196# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1197#elif defined(MFC_OpenMP)
1198# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1199
1200# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1201#endif
1202 do i = 1, num_fluids
1203 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
1204 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
1205 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
1206 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
1207 & + pres_r)
1208
1209 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
1210 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1211 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
1212 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
1213 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1214 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
1215 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
1216 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1217 & i + eqn_idx%adv%beg - 1))
1218 end do
1219
1220 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1221
1222 ! HYPOELASTIC STRESS EVOLUTION FLUX.
1223 if (hypoelasticity) then
1224
1225# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1226#if defined(MFC_OpenACC)
1227# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1228!$acc loop seq
1229# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1230#elif defined(MFC_OpenMP)
1231# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1232
1233# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1234#endif
1235 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1236 flux_rsx_vf(j, k, l, &
1237 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
1238 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
1239 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
1240 end do
1241 end if
1242
1243 ! Hyperelastic reference map flux for material deformation tracking
1244 if (hyperelasticity) then
1245
1246# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1247#if defined(MFC_OpenACC)
1248# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1249!$acc loop seq
1250# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1251#elif defined(MFC_OpenMP)
1252# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1253
1254# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1255#endif
1256 do i = 1, num_dims
1257 flux_rsx_vf(j, k, l, &
1258 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
1259 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
1260 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
1261 end do
1262 end if
1263
1264 ! COLOR FUNCTION FLUX
1265 if (surface_tension) then
1266 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
1267 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
1268 end if
1269
1270 ! Geometrical source flux for cylindrical coordinates
1271# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1272# 550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1273 end do
1274 end do
1275 end do
1276
1277# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1278#if defined(MFC_OpenACC)
1279# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1280!$acc end parallel loop
1281# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1282#elif defined(MFC_OpenMP)
1283# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1284
1285# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1286!$omp end target teams loop
1287# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1288#endif
1289 else if (model_eqns == model_eqns_4eq) then
1290 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
1291
1292# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1293
1294# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1295#if defined(MFC_OpenACC)
1296# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1297!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, 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)
1298# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1299#elif defined(MFC_OpenMP)
1300# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1301
1302# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1303
1304# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1305
1306# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1307!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, 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)
1308# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1309#endif
1310# 565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1311 do l = is3%beg, is3%end
1312 do k = is2%beg, is2%end
1313 do j = is1%beg, is1%end
1314 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1315 rho_l = 0._wp; rho_r = 0._wp
1316 gamma_l = 0._wp; gamma_r = 0._wp
1317 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1318 qv_l = 0._wp; qv_r = 0._wp
1319
1320
1321# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1322#if defined(MFC_OpenACC)
1323# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1324!$acc loop seq
1325# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1326#elif defined(MFC_OpenMP)
1327# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1328
1329# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1330#endif
1331 do i = 1, eqn_idx%cont%end
1332 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1333 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1334 end do
1335
1336
1337# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1338#if defined(MFC_OpenACC)
1339# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1340!$acc loop seq
1341# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1342#elif defined(MFC_OpenMP)
1343# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1344
1345# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1346#endif
1347 do i = 1, num_dims
1348 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1349 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1350 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1351 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1352 end do
1353
1354
1355# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1356#if defined(MFC_OpenACC)
1357# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1358!$acc loop seq
1359# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1360#elif defined(MFC_OpenMP)
1361# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1362
1363# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1364#endif
1365 do i = 1, num_fluids
1366 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1367 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1368 end do
1369
1370# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1371#if defined(MFC_OpenACC)
1372# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1373!$acc loop seq
1374# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1375#elif defined(MFC_OpenMP)
1376# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1377
1378# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1379#endif
1380 do i = 1, num_fluids
1381 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1382 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1383 end do
1384
1385
1386# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1387#if defined(MFC_OpenACC)
1388# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1389!$acc loop seq
1390# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1391#elif defined(MFC_OpenMP)
1392# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1393
1394# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1395#endif
1396 do i = 1, num_fluids
1397 rho_l = rho_l + alpha_rho_l(i)
1398 gamma_l = gamma_l + alpha_l(i)*gammas(i)
1399 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
1400 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
1401
1402 rho_r = rho_r + alpha_rho_r(i)
1403 gamma_r = gamma_r + alpha_r(i)*gammas(i)
1404 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
1405 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
1406 end do
1407
1408 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1409 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1410
1411 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
1412 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
1413
1414 h_l = (e_l + pres_l)/rho_l
1415 h_r = (e_r + pres_r)/rho_r
1416
1417 if (avg_state == avg_state_roe) then
1418# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1419 rho_avg = sqrt(rho_l*rho_r)
1420# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1421
1422# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1423 vel_avg_rms = 0._wp
1424# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1425
1426# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1427
1428# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1429#if defined(MFC_OpenACC)
1430# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1431!$acc loop seq
1432# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1433#elif defined(MFC_OpenMP)
1434# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1435
1436# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1437#endif
1438# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1439 do i = 1, num_vels
1440# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1441 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
1442# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1443 end do
1444# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1445
1446# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1447 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1448# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1449
1450# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1451 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1452# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1453
1454# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1455 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
1456# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1457
1458# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1459 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1460# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1461
1462# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1463 if (chemistry) then
1464# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1465 eps = 0.001_wp
1466# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1467 call get_species_enthalpies_rt(t_l, h_il)
1468# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1469 call get_species_enthalpies_rt(t_r, h_ir)
1470# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1471 h_il = h_il*gas_constant/molecular_weights*t_l
1472# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1473 h_ir = h_ir*gas_constant/molecular_weights*t_r
1474# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1475 call get_species_specific_heats_r(t_l, cp_il)
1476# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1477 call get_species_specific_heats_r(t_r, cp_ir)
1478# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1479
1480# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1481 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1482# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1483 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1484# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1485 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1486# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1487 if (abs(t_l - t_r) < eps) then
1488# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1489 ! Case when T_L and T_R are very close
1490# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1491 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1492# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1493 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
1494# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1495 & - gas_constant/molecular_weights(:)))
1496# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1497 else
1498# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1499 ! Normal calculation when T_L and T_R are sufficiently different
1500# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1501 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1502# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1503 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1504# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1505 end if
1506# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1507 gamma_avg = cp_avg/cv_avg
1508# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1509
1510# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1511 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1512# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1513 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1514# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1515 end if
1516# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1517 end if
1518# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1519
1520# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1521 if (avg_state == avg_state_arithmetic) then
1522# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1523 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1524# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1525 vel_avg_rms = 0._wp
1526# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1527
1528# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1529#if defined(MFC_OpenACC)
1530# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1531!$acc loop seq
1532# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1533#elif defined(MFC_OpenMP)
1534# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1535
1536# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1537#endif
1538# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1539 do i = 1, num_vels
1540# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1541 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1542# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1543 end do
1544# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1545
1546# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1547 h_avg = 5.e-1_wp*(h_l + h_r)
1548# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1549 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1550# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1551 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1552# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1553 end if
1554
1555 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
1556 & c_l, qv_l)
1557
1558 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
1559 & c_r, qv_r)
1560
1561 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1562 ! variables are placeholders to call the subroutine.
1563
1564 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1565 & 0._wp, c_avg, qv_avg)
1566
1567 if (wave_speeds == wave_speeds_direct) then
1568 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1569 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1570
1571 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1572 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1573 & - rho_r*(s_r - vel_r(dir_idx(1))))
1574 else if (wave_speeds == wave_speeds_pressure) then
1575 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1576
1577 pres_sr = pres_sl
1578
1579 ! Low Mach correction: Thornber et al. JCP (2008)
1580 ms_l = max(1._wp, &
1581 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1582 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1583 ms_r = max(1._wp, &
1584 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1585 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1586
1587 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1588 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1589
1590 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1591 end if
1592
1593 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1594 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1595
1596 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1597 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1598 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1599 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1600 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1601
1602 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1603 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1604 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1605
1606
1607# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1608#if defined(MFC_OpenACC)
1609# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1610!$acc loop seq
1611# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1612#elif defined(MFC_OpenMP)
1613# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1614
1615# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1616#endif
1617 do i = 1, eqn_idx%cont%end
1618 flux_rsx_vf(j, k, l, &
1619 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
1620 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1621 end do
1622
1623 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1624
1625# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1626#if defined(MFC_OpenACC)
1627# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1628!$acc loop seq
1629# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1630#elif defined(MFC_OpenMP)
1631# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1632
1633# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1634#endif
1635 do i = 1, num_dims
1636 flux_rsx_vf(j, k, l, &
1637 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
1638 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1639 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
1640 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1641 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1642 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
1643 end do
1644
1645 if (bubbles_euler) then
1646 ! Put p_tilde in
1647
1648# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1649#if defined(MFC_OpenACC)
1650# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1651!$acc loop seq
1652# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1653#elif defined(MFC_OpenMP)
1654# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1655
1656# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1657#endif
1658 do i = 1, num_dims
1659 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
1660 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
1661 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
1662 end do
1663 end if
1664
1665 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
1666
1667
1668# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1669#if defined(MFC_OpenACC)
1670# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1671!$acc loop seq
1672# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1673#elif defined(MFC_OpenMP)
1674# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1675
1676# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1677#endif
1678 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
1679 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1680 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1681 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1682 end do
1683
1684 ! Advection velocity source: interface velocity for volume fraction transport
1685
1686# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1687#if defined(MFC_OpenACC)
1688# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1689!$acc loop seq
1690# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1691#elif defined(MFC_OpenMP)
1692# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1693
1694# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1695#endif
1696 do i = 1, num_dims
1697 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
1698 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
1699 end do
1700
1701 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1702
1703 ! Add advection flux for bubble variables
1704 if (bubbles_euler) then
1705
1706# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1707#if defined(MFC_OpenACC)
1708# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1709!$acc loop seq
1710# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1711#elif defined(MFC_OpenMP)
1712# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1713
1714# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1715#endif
1716 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1717 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
1718 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1719 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
1720 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1721 end do
1722 end if
1723
1724 ! Geometrical source flux for cylindrical coordinates
1725
1726# 756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1727# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1728 end do
1729 end do
1730 end do
1731
1732# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1733#if defined(MFC_OpenACC)
1734# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1735!$acc end parallel loop
1736# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1737#elif defined(MFC_OpenMP)
1738# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1739
1740# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1741!$omp end target teams loop
1742# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1743#endif
1744 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
1745 ! 5-equation model with Euler-Euler bubble dynamics
1746
1747# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1748
1749# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1750#if defined(MFC_OpenACC)
1751# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1752!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
1753# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1754#elif defined(MFC_OpenMP)
1755# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1756
1757# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1758
1759# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1760
1761# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1762!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
1763# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1764#endif
1765# 786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1766 do l = is3%beg, is3%end
1767 do k = is2%beg, is2%end
1768 do j = is1%beg, is1%end
1769 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1770 rho_l = 0._wp; rho_r = 0._wp
1771 gamma_l = 0._wp; gamma_r = 0._wp
1772 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1773 qv_l = 0._wp; qv_r = 0._wp
1774
1775
1776# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1777#if defined(MFC_OpenACC)
1778# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1779!$acc loop seq
1780# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1781#elif defined(MFC_OpenMP)
1782# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1783
1784# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1785#endif
1786 do i = 1, num_fluids
1787 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1788 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1789 end do
1790
1791 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1792
1793
1794# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1795#if defined(MFC_OpenACC)
1796# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1797!$acc loop seq
1798# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1799#elif defined(MFC_OpenMP)
1800# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1801
1802# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1803#endif
1804 do i = 1, num_dims
1805 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1806 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1807 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1808 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1809 end do
1810
1811 ! Retain this in the refactor
1812 if (mpp_lim .and. (num_fluids > 2)) then
1813
1814# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1815#if defined(MFC_OpenACC)
1816# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1817!$acc loop seq
1818# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1819#elif defined(MFC_OpenMP)
1820# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1821
1822# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1823#endif
1824 do i = 1, num_fluids
1825 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
1826 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
1827 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
1828 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
1829 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
1830 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
1831 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
1832 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
1833 end do
1834 else if (num_fluids > 2) then
1835
1836# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1837#if defined(MFC_OpenACC)
1838# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1839!$acc loop seq
1840# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1841#elif defined(MFC_OpenMP)
1842# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1843
1844# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1845#endif
1846 do i = 1, num_fluids - 1
1847 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
1848 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
1849 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
1850 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
1851 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
1852 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
1853 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
1854 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
1855 end do
1856 else
1857 rho_l = ql_prim_rsx_vf(j, k, l, 1)
1858 gamma_l = gammas(1)
1859 pi_inf_l = pi_infs(1)
1860 qv_l = qvs(1)
1861 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
1862 gamma_r = gammas(1)
1863 pi_inf_r = pi_infs(1)
1864 qv_r = qvs(1)
1865 end if
1866
1867 if (viscous) then
1868 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
1869
1870# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1871#if defined(MFC_OpenACC)
1872# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1873!$acc loop seq
1874# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1875#elif defined(MFC_OpenMP)
1876# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1877
1878# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1879#endif
1880 do i = 1, 2
1881 re_l(i) = dflt_real
1882 re_r(i) = dflt_real
1883
1884 if (re_size(i) > 0) re_l(i) = 0._wp
1885 if (re_size(i) > 0) re_r(i) = 0._wp
1886
1887
1888# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1889#if defined(MFC_OpenACC)
1890# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1891!$acc loop seq
1892# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1893#elif defined(MFC_OpenMP)
1894# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1895
1896# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1897#endif
1898 do q = 1, re_size(i)
1899 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
1900 & q)))/res_gs(i, q) + re_l(i)
1901 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
1902 & q)))/res_gs(i, q) + re_r(i)
1903 end do
1904
1905 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1906 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1907 end do
1908 end if
1909 end if
1910
1911 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1912 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1913
1914 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
1915 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
1916
1917 h_l = (e_l + pres_l)/rho_l
1918 h_r = (e_r + pres_r)/rho_r
1919
1920 if (avg_state == avg_state_arithmetic) then
1921
1922# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1923#if defined(MFC_OpenACC)
1924# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1925!$acc loop seq
1926# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1927#elif defined(MFC_OpenMP)
1928# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1929
1930# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1931#endif
1932 do i = 1, nb
1933 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
1934 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
1935
1936 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
1937 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
1938 if (.not. polytropic .and. .not. qbmm) then
1939 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
1940 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
1941 end if
1942 end do
1943
1944 if (.not. qbmm) then
1945 if (adv_n) then
1946 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
1947 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
1948 else
1949 nbub_l = 0._wp
1950 nbub_r = 0._wp
1951
1952# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1953#if defined(MFC_OpenACC)
1954# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1955!$acc loop seq
1956# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1957#elif defined(MFC_OpenMP)
1958# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1959
1960# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1961#endif
1962 do i = 1, nb
1963 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
1964 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
1965 end do
1966
1967 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
1968 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
1969 & eqn_idx%E + num_fluids)/nbub_r
1970 end if
1971 else
1972 ! nb stored in 0th moment of first R0 bin in variable conversion module
1973 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
1974 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
1975 end if
1976
1977
1978# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1979#if defined(MFC_OpenACC)
1980# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1981!$acc loop seq
1982# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1983#elif defined(MFC_OpenMP)
1984# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1985
1986# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1987#endif
1988 do i = 1, nb
1989 if (.not. qbmm) then
1990 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
1991 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
1992 end if
1993 end do
1994
1995 if (qbmm) then
1996 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
1997 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
1998
1999 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
2000 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
2001
2002 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
2003 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
2004 else
2005 pbwr3lbar = 0._wp
2006 pbwr3rbar = 0._wp
2007
2008 r3lbar = 0._wp
2009 r3rbar = 0._wp
2010
2011 r3v2lbar = 0._wp
2012 r3v2rbar = 0._wp
2013
2014
2015# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2016#if defined(MFC_OpenACC)
2017# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2018!$acc loop seq
2019# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2020#elif defined(MFC_OpenMP)
2021# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2022
2023# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2024#endif
2025 do i = 1, nb
2026 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
2027 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
2028
2029 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
2030 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
2031
2032 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
2033 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
2034 end do
2035 end if
2036
2037 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2038 h_avg = 5.e-1_wp*(h_l + h_r)
2039 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2040 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2041 vel_avg_rms = 0._wp
2042
2043
2044# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2045#if defined(MFC_OpenACC)
2046# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2047!$acc loop seq
2048# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2049#elif defined(MFC_OpenMP)
2050# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2051
2052# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2053#endif
2054 do i = 1, num_dims
2055 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2056 end do
2057 end if
2058
2059 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
2060 & c_l, qv_l)
2061
2062 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
2063 & c_r, qv_r)
2064
2065 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2066 ! variables are placeholders to call the subroutine.
2067 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2068 & 0._wp, c_avg, qv_avg)
2069
2070 if (viscous) then
2071
2072# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2073#if defined(MFC_OpenACC)
2074# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2075!$acc loop seq
2076# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2077#elif defined(MFC_OpenMP)
2078# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2079
2080# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2081#endif
2082 do i = 1, 2
2083 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2084 end do
2085 end if
2086
2087 ! Low Mach correction
2088 if (low_mach == 2) then
2089 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2090# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2091 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2092# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2093 pcorr = 0._wp
2094# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2095
2096# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2097 if (low_mach == 1) then
2098# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2099 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2100# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2101 end if
2102# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2103 else if (riemann_solver == riemann_solver_hllc) then
2104# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2105 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2106# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2107 pcorr = 0._wp
2108# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2109
2110# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2111 if (low_mach == 1) then
2112# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2113 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))) &
2114# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2115 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2116# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2117 else if (low_mach == 2) then
2118# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2119 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))))
2120# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2121 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))))
2122# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2123 vel_l(dir_idx(1)) = vel_l_tmp
2124# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2125 vel_r(dir_idx(1)) = vel_r_tmp
2126# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2127 end if
2128# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2129 end if
2130 end if
2131
2132 if (wave_speeds == wave_speeds_direct) then
2133 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2134 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2135
2136 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2137 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2138 & - rho_r*(s_r - vel_r(dir_idx(1))))
2139 else if (wave_speeds == wave_speeds_pressure) then
2140 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2141
2142 pres_sr = pres_sl
2143
2144 ! Low Mach correction: Thornber et al. JCP (2008)
2145 ms_l = max(1._wp, &
2146 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2147 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2148 ms_r = max(1._wp, &
2149 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2150 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2151
2152 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2153 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2154
2155 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2156 end if
2157
2158 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2159 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2160
2161 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2162 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2163 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2164 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2165 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2166
2167 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2168 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2169 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2170
2171 ! Low Mach correction
2172 if (low_mach == 1) then
2173 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2174# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2175 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2176# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2177 pcorr = 0._wp
2178# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2179
2180# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2181 if (low_mach == 1) then
2182# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2183 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2184# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2185 end if
2186# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2187 else if (riemann_solver == riemann_solver_hllc) then
2188# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2189 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2190# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2191 pcorr = 0._wp
2192# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2193
2194# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2195 if (low_mach == 1) then
2196# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2197 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))) &
2198# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2199 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2200# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2201 else if (low_mach == 2) then
2202# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2203 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))))
2204# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2205 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))))
2206# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2207 vel_l(dir_idx(1)) = vel_l_tmp
2208# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2209 vel_r(dir_idx(1)) = vel_r_tmp
2210# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2211 end if
2212# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2213 end if
2214 else
2215 pcorr = 0._wp
2216 end if
2217
2218
2219# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2220#if defined(MFC_OpenACC)
2221# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2222!$acc loop seq
2223# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2224#elif defined(MFC_OpenMP)
2225# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2226
2227# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2228#endif
2229 do i = 1, eqn_idx%cont%end
2230 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2231 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2232 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2233 end do
2234
2235 if (bubbles_euler .and. (num_fluids > 1)) then
2236 ! Kill mass transport @ gas density
2237 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
2238 end if
2239
2240 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
2241
2242 ! Include p_tilde
2243
2244 if (avg_state == avg_state_arithmetic) then
2245 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
2246 pres_l = pres_l - alpha_l(num_fluids)*pres_l
2247 else
2248 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
2249 end if
2250
2251 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
2252 pres_r = pres_r - alpha_r(num_fluids)*pres_r
2253 else
2254 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
2255 end if
2256 end if
2257
2258
2259# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2260#if defined(MFC_OpenACC)
2261# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2262!$acc loop seq
2263# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2264#elif defined(MFC_OpenMP)
2265# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2266
2267# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2268#endif
2269 do i = 1, num_dims
2270 flux_rsx_vf(j, k, l, &
2271 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
2272 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
2273 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
2274 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2275 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
2276 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
2277 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
2278 end do
2279
2280 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
2281 flux_rsx_vf(j, k, l, &
2282 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
2283 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
2284 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
2285 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
2286 & *pcorr*s_s
2287
2288 ! Volume fraction flux
2289
2290# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2291#if defined(MFC_OpenACC)
2292# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2293!$acc loop seq
2294# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2295#elif defined(MFC_OpenMP)
2296# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2297
2298# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2299#endif
2300 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2301 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2302 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2303 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2304 end do
2305
2306 ! Advection velocity source: interface velocity for volume fraction transport
2307
2308# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2309#if defined(MFC_OpenACC)
2310# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2311!$acc loop seq
2312# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2313#elif defined(MFC_OpenMP)
2314# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2315
2316# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2317#endif
2318 do i = 1, num_dims
2319 vel_src_rsx_vf(j, k, l, &
2320 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2321 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2322
2323 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
2324 end do
2325
2326 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2327
2328 ! Add advection flux for bubble variables
2329
2330# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2331#if defined(MFC_OpenACC)
2332# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2333!$acc loop seq
2334# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2335#elif defined(MFC_OpenMP)
2336# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2337
2338# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2339#endif
2340 do i = eqn_idx%bub%beg, eqn_idx%bub%end
2341 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
2342 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2343 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2344 end do
2345
2346 if (qbmm) then
2347 flux_rsx_vf(j, k, l, &
2348 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2349 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2350 end if
2351
2352 if (adv_n) then
2353 flux_rsx_vf(j, k, l, &
2354 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2355 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2356 end if
2357
2358 ! Geometrical source flux for cylindrical coordinates
2359# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2360# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2361 end do
2362 end do
2363 end do
2364
2365# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2366#if defined(MFC_OpenACC)
2367# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2368!$acc end parallel loop
2369# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2370#elif defined(MFC_OpenMP)
2371# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2372
2373# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2374!$omp end target teams loop
2375# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2376#endif
2377 else
2378 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
2379
2380# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2381
2382# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2383#if defined(MFC_OpenACC)
2384# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2385!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, 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, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
2386# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2387#elif defined(MFC_OpenMP)
2388# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2389
2390# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2391
2392# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2393
2394# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2395!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, 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, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
2396# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2397#endif
2398# 1183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2399 do l = is3%beg, is3%end
2400 do k = is2%beg, is2%end
2401 do j = is1%beg, is1%end
2402 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2403 rho_l = 0._wp; rho_r = 0._wp
2404 gamma_l = 0._wp; gamma_r = 0._wp
2405 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2406 qv_l = 0._wp; qv_r = 0._wp
2407 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2408
2409
2410# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2411#if defined(MFC_OpenACC)
2412# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2413!$acc loop seq
2414# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2415#elif defined(MFC_OpenMP)
2416# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2417
2418# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2419#endif
2420 do i = 1, num_fluids
2421 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2422 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2423 end do
2424
2425
2426# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2427#if defined(MFC_OpenACC)
2428# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2429!$acc loop seq
2430# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2431#elif defined(MFC_OpenMP)
2432# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2433
2434# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2435#endif
2436 do i = 1, num_dims
2437 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2438 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
2439 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2440 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2441 end do
2442
2443 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2444 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
2445
2446 ! Change this by splitting it into the cases present in the bubbles_euler
2447 if (mpp_lim) then
2448
2449# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2450#if defined(MFC_OpenACC)
2451# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2452!$acc loop seq
2453# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2454#elif defined(MFC_OpenMP)
2455# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2456
2457# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2458#endif
2459 do i = 1, num_fluids
2460 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2461 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2462 & eqn_idx%E + i)), 1._wp)
2463 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
2464 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
2465 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
2466 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2467 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2468 end do
2469
2470
2471# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2472#if defined(MFC_OpenACC)
2473# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2474!$acc loop seq
2475# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2476#elif defined(MFC_OpenMP)
2477# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2478
2479# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2480#endif
2481 do i = 1, num_fluids
2482 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2483 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2484 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
2485 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2486 end do
2487 end if
2488
2489
2490# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2491#if defined(MFC_OpenACC)
2492# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2493!$acc loop seq
2494# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2495#elif defined(MFC_OpenMP)
2496# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2497
2498# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2499#endif
2500 do i = 1, num_fluids
2501 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
2502 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
2503 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
2504 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
2505
2506 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
2507 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
2508 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
2509 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
2510 end do
2511
2512 re_max = 0
2513 if (re_size(1) > 0) re_max = 1
2514 if (re_size(2) > 0) re_max = 2
2515
2516 if (viscous) then
2517
2518# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2519#if defined(MFC_OpenACC)
2520# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2521!$acc loop seq
2522# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2523#elif defined(MFC_OpenMP)
2524# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2525
2526# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2527#endif
2528 do i = 1, re_max
2529 re_l(i) = 0._wp
2530 re_r(i) = 0._wp
2531
2532
2533# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2534#if defined(MFC_OpenACC)
2535# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2536!$acc loop seq
2537# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2538#elif defined(MFC_OpenMP)
2539# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2540
2541# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2542#endif
2543 do q = 1, re_size(i)
2544 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
2545 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
2546 end do
2547
2548 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2549 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2550 end do
2551 end if
2552
2553 if (chemistry) then
2554 c_sum_yi_phi = 0.0_wp
2555
2556# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2557#if defined(MFC_OpenACC)
2558# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2559!$acc loop seq
2560# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2561#elif defined(MFC_OpenMP)
2562# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2563
2564# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2565#endif
2566 do i = eqn_idx%species%beg, eqn_idx%species%end
2567 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2568 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
2569 end do
2570
2571 call get_mixture_molecular_weight(ys_l, mw_l)
2572 call get_mixture_molecular_weight(ys_r, mw_r)
2573
2574 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2575 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2576
2577 r_gas_l = gas_constant/mw_l
2578 r_gas_r = gas_constant/mw_r
2579
2580 t_l = pres_l/rho_l/r_gas_l
2581 t_r = pres_r/rho_r/r_gas_r
2582
2583 call get_species_specific_heats_r(t_l, cp_il)
2584 call get_species_specific_heats_r(t_r, cp_ir)
2585
2586 if (chem_params%gamma_method == 1) then
2587 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2588 gamma_il = cp_il/(cp_il - 1.0_wp)
2589 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2590
2591 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2592 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2593 else if (chem_params%gamma_method == 2) then
2594 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2595 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2596 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2597 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2598 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2599
2600 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
2601 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2602 end if
2603
2604 call get_mixture_energy_mass(t_l, ys_l, e_l)
2605 call get_mixture_energy_mass(t_r, ys_r, e_r)
2606
2607 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2608 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2609 h_l = (e_l + pres_l)/rho_l
2610 h_r = (e_r + pres_r)/rho_r
2611 else
2612 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2613 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2614
2615 h_l = (e_l + pres_l)/rho_l
2616 h_r = (e_r + pres_r)/rho_r
2617 end if
2618
2619 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
2620 if (hypoelasticity) then
2621
2622# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2623#if defined(MFC_OpenACC)
2624# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2625!$acc loop seq
2626# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2627#elif defined(MFC_OpenMP)
2628# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2629
2630# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2631#endif
2632 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2633 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2634 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2635 end do
2636 g_l = 0._wp
2637 g_r = 0._wp
2638
2639# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2640#if defined(MFC_OpenACC)
2641# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2642!$acc loop seq
2643# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2644#elif defined(MFC_OpenMP)
2645# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2646
2647# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2648#endif
2649 do i = 1, num_fluids
2650 g_l = g_l + alpha_l(i)*gs_rs(i)
2651 g_r = g_r + alpha_r(i)*gs_rs(i)
2652 end do
2653
2654# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2655#if defined(MFC_OpenACC)
2656# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2657!$acc loop seq
2658# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2659#elif defined(MFC_OpenMP)
2660# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2661
2662# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2663#endif
2664 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2665 ! Elastic contribution to energy if G large enough
2666 if ((g_l > verysmall) .and. (g_r > verysmall)) then
2667 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2668 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2669 ! Additional terms in 2D and 3D
2670 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
2671 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2672 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2673 end if
2674 end if
2675 end do
2676 end if
2677
2678 ! Hyperelastic stress contribution: strain energy added to total energy
2679 if (hyperelasticity) then
2680
2681# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2682#if defined(MFC_OpenACC)
2683# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2684!$acc loop seq
2685# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2686#elif defined(MFC_OpenMP)
2687# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2688
2689# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2690#endif
2691 do i = 1, num_dims
2692 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
2693 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
2694 end do
2695 g_l = 0._wp
2696 g_r = 0._wp
2697
2698# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2699#if defined(MFC_OpenACC)
2700# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2701!$acc loop seq
2702# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2703#elif defined(MFC_OpenMP)
2704# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2705
2706# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2707#endif
2708 do i = 1, num_fluids
2709 ! Mixture left and right shear modulus
2710 g_l = g_l + alpha_l(i)*gs_rs(i)
2711 g_r = g_r + alpha_r(i)*gs_rs(i)
2712 end do
2713 ! Elastic contribution to energy if G large enough
2714 if (g_l > verysmall .and. g_r > verysmall) then
2715 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
2716 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
2717 end if
2718
2719# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2720#if defined(MFC_OpenACC)
2721# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2722!$acc loop seq
2723# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2724#elif defined(MFC_OpenMP)
2725# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2726
2727# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2728#endif
2729 do i = 1, b_size - 1
2730 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2731 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2732 end do
2733 end if
2734
2735 h_l = (e_l + pres_l)/rho_l
2736 h_r = (e_r + pres_r)/rho_r
2737
2738 if (avg_state == avg_state_roe) then
2739# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2740 rho_avg = sqrt(rho_l*rho_r)
2741# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2742
2743# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2744 vel_avg_rms = 0._wp
2745# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2746
2747# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2748
2749# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2750#if defined(MFC_OpenACC)
2751# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2752!$acc loop seq
2753# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2754#elif defined(MFC_OpenMP)
2755# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2756
2757# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2758#endif
2759# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2760 do i = 1, num_vels
2761# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2762 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
2763# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2764 end do
2765# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2766
2767# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2768 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
2769# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2770
2771# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2772 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
2773# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2774
2775# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2776 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
2777# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2778
2779# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2780 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
2781# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2782
2783# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2784 if (chemistry) then
2785# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2786 eps = 0.001_wp
2787# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2788 call get_species_enthalpies_rt(t_l, h_il)
2789# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2790 call get_species_enthalpies_rt(t_r, h_ir)
2791# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2792 h_il = h_il*gas_constant/molecular_weights*t_l
2793# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2794 h_ir = h_ir*gas_constant/molecular_weights*t_r
2795# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2796 call get_species_specific_heats_r(t_l, cp_il)
2797# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2798 call get_species_specific_heats_r(t_r, cp_ir)
2799# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2800
2801# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2802 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2803# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2804 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2805# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2806 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2807# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2808 if (abs(t_l - t_r) < eps) then
2809# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2810 ! Case when T_L and T_R are very close
2811# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2812 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2813# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2814 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2815# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2816 & - gas_constant/molecular_weights(:)))
2817# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2818 else
2819# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2820 ! Normal calculation when T_L and T_R are sufficiently different
2821# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2822 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2823# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2824 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2825# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2826 end if
2827# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2828 gamma_avg = cp_avg/cv_avg
2829# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2830
2831# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2832 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2833# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2834 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2835# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2836 end if
2837# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2838 end if
2839# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2840
2841# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2842 if (avg_state == avg_state_arithmetic) then
2843# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2844 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2845# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2846 vel_avg_rms = 0._wp
2847# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2848
2849# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2850#if defined(MFC_OpenACC)
2851# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2852!$acc loop seq
2853# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2854#elif defined(MFC_OpenMP)
2855# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2856
2857# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2858#endif
2859# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2860 do i = 1, num_vels
2861# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2862 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2863# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2864 end do
2865# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2866
2867# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2868 h_avg = 5.e-1_wp*(h_l + h_r)
2869# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2870 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2871# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2872 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2873# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2874 end if
2875
2876 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
2877 & c_l, qv_l)
2878
2879 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
2880 & c_r, qv_r)
2881
2882 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2883 ! variables are placeholders to call the subroutine.
2884 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2885 & c_sum_yi_phi, c_avg, qv_avg)
2886
2887 if (viscous) then
2888 if (chemistry) then
2889 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2890 end if
2891
2892# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2893#if defined(MFC_OpenACC)
2894# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2895!$acc loop seq
2896# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2897#elif defined(MFC_OpenMP)
2898# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2899
2900# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2901#endif
2902 do i = 1, 2
2903 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2904 end do
2905 end if
2906
2907 ! Low Mach correction
2908 if (low_mach == 2) then
2909 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2910# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2911 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2912# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2913 pcorr = 0._wp
2914# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2915
2916# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2917 if (low_mach == 1) then
2918# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2919 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2920# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2921 end if
2922# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2923 else if (riemann_solver == riemann_solver_hllc) then
2924# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2925 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2926# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2927 pcorr = 0._wp
2928# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2929
2930# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2931 if (low_mach == 1) then
2932# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2933 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))) &
2934# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2935 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2936# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2937 else if (low_mach == 2) then
2938# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2939 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))))
2940# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2941 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))))
2942# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2943 vel_l(dir_idx(1)) = vel_l_tmp
2944# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2945 vel_r(dir_idx(1)) = vel_r_tmp
2946# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2947 end if
2948# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2949 end if
2950 end if
2951
2952 if (wave_speeds == wave_speeds_direct) then
2953 if (elasticity) then
2954 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2955 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
2956 & ))/rho_l), &
2957 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
2958 & + tau_e_r(dir_idx_tau(1)))/rho_r))
2959 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
2960 & ))/rho_r), &
2961 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
2962 & + tau_e_l(dir_idx_tau(1)))/rho_l))
2963 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
2964 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
2965 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
2966 & - vel_r(dir_idx(1))))
2967 else
2968 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2969 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2970 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2971 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
2972 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
2973 end if
2974 else if (wave_speeds == wave_speeds_pressure) then
2975 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2976
2977 pres_sr = pres_sl
2978
2979 ! Low Mach correction: Thornber et al. JCP (2008)
2980 ms_l = max(1._wp, &
2981 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2982 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2983 ms_r = max(1._wp, &
2984 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2985 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2986
2987 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2988 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2989
2990 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2991 end if
2992
2993 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2994 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2995
2996 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2997 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2998 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2999 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
3000 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3001 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3002
3003 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3004 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
3005 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
3006
3007 ! Low Mach correction
3008 if (low_mach == 1) then
3009 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3010# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3011 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3012# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3013 pcorr = 0._wp
3014# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3015
3016# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3017 if (low_mach == 1) then
3018# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3019 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3020# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3021 end if
3022# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3023 else if (riemann_solver == riemann_solver_hllc) then
3024# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3025 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3026# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3027 pcorr = 0._wp
3028# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3029
3030# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3031 if (low_mach == 1) then
3032# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3033 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))) &
3034# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3035 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3036# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3037 else if (low_mach == 2) then
3038# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3039 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))))
3040# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3041 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))))
3042# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3043 vel_l(dir_idx(1)) = vel_l_tmp
3044# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3045 vel_r(dir_idx(1)) = vel_r_tmp
3046# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3047 end if
3048# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3049 end if
3050 else
3051 pcorr = 0._wp
3052 end if
3053
3054 ! COMPUTING THE HLLC FLUXES MASS FLUX.
3055
3056# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3057#if defined(MFC_OpenACC)
3058# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3059!$acc loop seq
3060# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3061#elif defined(MFC_OpenMP)
3062# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3063
3064# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3065#endif
3066 do i = 1, eqn_idx%cont%end
3067 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3068 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3069 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3070 end do
3071
3072 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
3073 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
3074
3075# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3076#if defined(MFC_OpenACC)
3077# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3078!$acc loop seq
3079# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3080#elif defined(MFC_OpenMP)
3081# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3082
3083# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3084#endif
3085 do i = 1, num_dims
3086 flux_rsx_vf(j, k, l, &
3087 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
3088 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
3089 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
3090 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
3091 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
3092 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
3093 end do
3094
3095 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3096 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
3097 flux_rsx_vf(j, k, l, &
3098 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 + xi_l*(s_s &
3099 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
3100 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
3101 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
3102 & *(s_p/s_r)*pcorr*s_s
3103
3104 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
3105 if (elasticity) then
3106 flux_ene_e = 0._wp
3107
3108# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3109#if defined(MFC_OpenACC)
3110# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3111!$acc loop seq
3112# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3113#elif defined(MFC_OpenMP)
3114# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3115
3116# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3117#endif
3118 do i = 1, num_dims
3119 ! MOMENTUM ELASTIC FLUX.
3120 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
3121 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
3122 & - xi_p*tau_e_r(dir_idx_tau(i))
3123 ! ENERGY ELASTIC FLUX.
3124 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
3125 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
3126 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
3127 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
3128 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
3129 end do
3130 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
3131 end if
3132
3133 ! HYPOELASTIC STRESS EVOLUTION FLUX.
3134 if (hypoelasticity) then
3135
3136# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3137#if defined(MFC_OpenACC)
3138# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3139!$acc loop seq
3140# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3141#elif defined(MFC_OpenMP)
3142# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3143
3144# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3145#endif
3146 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
3147 flux_rsx_vf(j, k, l, &
3148 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
3149 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
3150 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
3151 end do
3152 end if
3153
3154 ! VOLUME FRACTION FLUX.
3155
3156# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3157#if defined(MFC_OpenACC)
3158# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3159!$acc loop seq
3160# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3161#elif defined(MFC_OpenMP)
3162# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3163
3164# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3165#endif
3166 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3167 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3168 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3169 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3170 end do
3171
3172 ! VOLUME FRACTION SOURCE FLUX.
3173
3174# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3175#if defined(MFC_OpenACC)
3176# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3177!$acc loop seq
3178# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3179#elif defined(MFC_OpenMP)
3180# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3181
3182# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3183#endif
3184 do i = 1, num_dims
3185 vel_src_rsx_vf(j, k, l, &
3186 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
3187 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
3188 end do
3189
3190 ! COLOR FUNCTION FLUX
3191 if (surface_tension) then
3192 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
3193 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3194 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3195 end if
3196
3197 ! Hyperelastic reference map flux for material deformation tracking
3198 if (hyperelasticity) then
3199
3200# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3201#if defined(MFC_OpenACC)
3202# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3203!$acc loop seq
3204# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3205#elif defined(MFC_OpenMP)
3206# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3207
3208# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3209#endif
3210 do i = 1, num_dims
3211 flux_rsx_vf(j, k, l, &
3212 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
3213 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
3214 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
3215 end do
3216 end if
3217
3218 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3219
3220 if (chemistry) then
3221
3222# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3223#if defined(MFC_OpenACC)
3224# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3225!$acc loop seq
3226# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3227#elif defined(MFC_OpenMP)
3228# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3229
3230# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3231#endif
3232 do i = eqn_idx%species%beg, eqn_idx%species%end
3233 y_l = ql_prim_rsx_vf(j, k, l, i)
3234 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
3235
3236 flux_rsx_vf(j, k, l, &
3237 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3238 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3239 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
3240 end do
3241 end if
3242
3243 ! Geometrical source flux for cylindrical coordinates
3244# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3245# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3246 end do
3247 end do
3248 end do
3249
3250# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3251#if defined(MFC_OpenACC)
3252# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3253!$acc end parallel loop
3254# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3255#elif defined(MFC_OpenMP)
3256# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3257
3258# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3259!$omp end target teams loop
3260# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3261#endif
3262 end if
3263 end if
3264# 135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3265# 136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3266# 137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3267 if (norm_dir == 2) then
3268 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
3269 if (model_eqns == model_eqns_6eq) then
3270 ! 6-equation model (model_eqns=3): separate phasic internal energies
3271
3272# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3273
3274# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3275#if defined(MFC_OpenACC)
3276# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3277!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP)
3278# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3279#elif defined(MFC_OpenMP)
3280# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3281
3282# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3283
3284# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3285
3286# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3287!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP)
3288# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3289#endif
3290# 151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3291 do l = is3%beg, is3%end
3292 do k = is1%beg, is1%end
3293 do j = is2%beg, is2%end
3294 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3295 rho_l = 0._wp; rho_r = 0._wp
3296 gamma_l = 0._wp; gamma_r = 0._wp
3297 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3298 qv_l = 0._wp; qv_r = 0._wp
3299 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
3300
3301
3302# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3303#if defined(MFC_OpenACC)
3304# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3305!$acc loop seq
3306# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3307#elif defined(MFC_OpenMP)
3308# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3309
3310# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3311#endif
3312 do i = 1, num_dims
3313 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3314 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3315 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3316 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3317 end do
3318
3319 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3320 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3321
3322 rho_l = 0._wp
3323 gamma_l = 0._wp
3324 pi_inf_l = 0._wp
3325 qv_l = 0._wp
3326
3327 rho_r = 0._wp
3328 gamma_r = 0._wp
3329 pi_inf_r = 0._wp
3330 qv_r = 0._wp
3331
3332 alpha_l_sum = 0._wp
3333 alpha_r_sum = 0._wp
3334
3335 if (mpp_lim) then
3336
3337# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3338#if defined(MFC_OpenACC)
3339# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3340!$acc loop seq
3341# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3342#elif defined(MFC_OpenMP)
3343# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3344
3345# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3346#endif
3347 do i = 1, num_fluids
3348 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
3349 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
3350 & eqn_idx%E + i)), 1._wp)
3351 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3352 end do
3353
3354
3355# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3356#if defined(MFC_OpenACC)
3357# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3358!$acc loop seq
3359# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3360#elif defined(MFC_OpenMP)
3361# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3362
3363# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3364#endif
3365 do i = 1, num_fluids
3366 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
3367 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
3368 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
3369 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3370 end do
3371
3372
3373# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3374#if defined(MFC_OpenACC)
3375# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3376!$acc loop seq
3377# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3378#elif defined(MFC_OpenMP)
3379# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3380
3381# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3382#endif
3383 do i = 1, num_fluids
3384 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
3385 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
3386 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
3387 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
3388 end do
3389 end if
3390
3391
3392# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3393#if defined(MFC_OpenACC)
3394# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3395!$acc loop seq
3396# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3397#elif defined(MFC_OpenMP)
3398# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3399
3400# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3401#endif
3402 do i = 1, num_fluids
3403 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
3404 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
3405 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
3406 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
3407
3408 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
3409 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
3410 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
3411 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
3412
3413 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
3414 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
3415 end do
3416
3417 if (viscous) then
3418
3419# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3420#if defined(MFC_OpenACC)
3421# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3422!$acc loop seq
3423# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3424#elif defined(MFC_OpenMP)
3425# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3426
3427# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3428#endif
3429 do i = 1, 2
3430 re_l(i) = dflt_real
3431 re_r(i) = dflt_real
3432 if (re_size(i) > 0) re_l(i) = 0._wp
3433 if (re_size(i) > 0) re_r(i) = 0._wp
3434
3435# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3436#if defined(MFC_OpenACC)
3437# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3438!$acc loop seq
3439# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3440#elif defined(MFC_OpenMP)
3441# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3442
3443# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3444#endif
3445 do q = 1, re_size(i)
3446 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
3447 re_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
3448 & q) + re_r(i)
3449 end do
3450 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3451 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3452 end do
3453 end if
3454
3455 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
3456 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
3457
3458 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
3459 if (hypoelasticity) then
3460
3461# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3462#if defined(MFC_OpenACC)
3463# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3464!$acc loop seq
3465# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3466#elif defined(MFC_OpenMP)
3467# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3468
3469# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3470#endif
3471 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
3472 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
3473 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
3474 end do
3475 g_l = 0._wp; g_r = 0._wp
3476
3477# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3478#if defined(MFC_OpenACC)
3479# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3480!$acc loop seq
3481# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3482#elif defined(MFC_OpenMP)
3483# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3484
3485# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3486#endif
3487 do i = 1, num_fluids
3488 g_l = g_l + alpha_l(i)*gs_rs(i)
3489 g_r = g_r + alpha_r(i)*gs_rs(i)
3490 end do
3491
3492# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3493#if defined(MFC_OpenACC)
3494# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3495!$acc loop seq
3496# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3497#elif defined(MFC_OpenMP)
3498# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3499
3500# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3501#endif
3502 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
3503 ! Elastic contribution to energy if G large enough
3504 if ((g_l > verysmall) .and. (g_r > verysmall)) then
3505 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3506 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3507 ! Additional terms in 2D and 3D
3508 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
3509 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3510 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3511 end if
3512 end if
3513 end do
3514 end if
3515
3516 ! Hyperelastic stress contribution: strain energy added to total energy
3517 if (hyperelasticity) then
3518
3519# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3520#if defined(MFC_OpenACC)
3521# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3522!$acc loop seq
3523# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3524#elif defined(MFC_OpenMP)
3525# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3526
3527# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3528#endif
3529 do i = 1, num_dims
3530 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
3531 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
3532 end do
3533 g_l = 0._wp; g_r = 0._wp
3534
3535# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3536#if defined(MFC_OpenACC)
3537# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3538!$acc loop seq
3539# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3540#elif defined(MFC_OpenMP)
3541# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3542
3543# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3544#endif
3545 do i = 1, num_fluids
3546 ! Mixture left and right shear modulus
3547 g_l = g_l + alpha_l(i)*gs_rs(i)
3548 g_r = g_r + alpha_r(i)*gs_rs(i)
3549 end do
3550 ! Elastic contribution to energy if G large enough
3551 if (g_l > verysmall .and. g_r > verysmall) then
3552 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
3553 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
3554 end if
3555
3556# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3557#if defined(MFC_OpenACC)
3558# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3559!$acc loop seq
3560# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3561#elif defined(MFC_OpenMP)
3562# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3563
3564# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3565#endif
3566 do i = 1, b_size - 1
3567 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
3568 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
3569 end do
3570 end if
3571
3572 h_l = (e_l + pres_l)/rho_l
3573 h_r = (e_r + pres_r)/rho_r
3574
3575 if (avg_state == avg_state_roe) then
3576# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3577 rho_avg = sqrt(rho_l*rho_r)
3578# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3579
3580# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3581 vel_avg_rms = 0._wp
3582# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3583
3584# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3585
3586# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3587#if defined(MFC_OpenACC)
3588# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3589!$acc loop seq
3590# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3591#elif defined(MFC_OpenMP)
3592# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3593
3594# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3595#endif
3596# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3597 do i = 1, num_vels
3598# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3599 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
3600# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3601 end do
3602# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3603
3604# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3605 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3606# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3607
3608# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3609 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3610# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3611
3612# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3613 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
3614# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3615
3616# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3617 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3618# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3619
3620# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3621 if (chemistry) then
3622# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3623 eps = 0.001_wp
3624# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3625 call get_species_enthalpies_rt(t_l, h_il)
3626# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3627 call get_species_enthalpies_rt(t_r, h_ir)
3628# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3629 h_il = h_il*gas_constant/molecular_weights*t_l
3630# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3631 h_ir = h_ir*gas_constant/molecular_weights*t_r
3632# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3633 call get_species_specific_heats_r(t_l, cp_il)
3634# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3635 call get_species_specific_heats_r(t_r, cp_ir)
3636# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3637
3638# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3639 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3640# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3641 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3642# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3643 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3644# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3645 if (abs(t_l - t_r) < eps) then
3646# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3647 ! Case when T_L and T_R are very close
3648# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3649 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3650# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3651 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3652# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3653 & - gas_constant/molecular_weights(:)))
3654# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3655 else
3656# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3657 ! Normal calculation when T_L and T_R are sufficiently different
3658# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3659 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3660# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3661 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3662# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3663 end if
3664# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3665 gamma_avg = cp_avg/cv_avg
3666# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3667
3668# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3669 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3670# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3671 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3672# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3673 end if
3674# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3675 end if
3676# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3677
3678# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3679 if (avg_state == avg_state_arithmetic) then
3680# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3681 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3682# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3683 vel_avg_rms = 0._wp
3684# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3685
3686# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3687#if defined(MFC_OpenACC)
3688# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3689!$acc loop seq
3690# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3691#elif defined(MFC_OpenMP)
3692# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3693
3694# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3695#endif
3696# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3697 do i = 1, num_vels
3698# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3699 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3700# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3701 end do
3702# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3703
3704# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3705 h_avg = 5.e-1_wp*(h_l + h_r)
3706# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3707 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3708# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3709 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3710# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3711 end if
3712
3713 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
3714 & c_l, qv_l)
3715
3716 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
3717 & c_r, qv_r)
3718
3719 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3720 ! variables are placeholders to call the subroutine.
3721 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3722 & 0._wp, c_avg, qv_avg)
3723
3724 if (viscous) then
3725
3726# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3727#if defined(MFC_OpenACC)
3728# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3729!$acc loop seq
3730# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3731#elif defined(MFC_OpenMP)
3732# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3733
3734# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3735#endif
3736 do i = 1, 2
3737 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3738 end do
3739 end if
3740
3741 ! Low Mach correction
3742 if (low_mach == 2) then
3743 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3744# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3745 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3746# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3747 pcorr = 0._wp
3748# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3749
3750# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3751 if (low_mach == 1) then
3752# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3753 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3754# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3755 end if
3756# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3757 else if (riemann_solver == riemann_solver_hllc) then
3758# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3759 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3760# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3761 pcorr = 0._wp
3762# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3763
3764# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3765 if (low_mach == 1) then
3766# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3767 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))) &
3768# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3769 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3770# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3771 else if (low_mach == 2) then
3772# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3773 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))))
3774# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3775 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))))
3776# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3777 vel_l(dir_idx(1)) = vel_l_tmp
3778# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3779 vel_r(dir_idx(1)) = vel_r_tmp
3780# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3781 end if
3782# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3783 end if
3784 end if
3785
3786 ! COMPUTING THE DIRECT WAVE SPEEDS
3787 if (wave_speeds == wave_speeds_direct) then
3788 if (elasticity) then
3789 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3790 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
3791 & ))/rho_l), &
3792 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
3793 & + tau_e_r(dir_idx_tau(1)))/rho_r))
3794 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
3795 & ))/rho_r), &
3796 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
3797 & + tau_e_l(dir_idx_tau(1)))/rho_l))
3798 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
3799 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
3800 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
3801 & - vel_r(dir_idx(1))))
3802 else
3803 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3804 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3805 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3806 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
3807 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
3808 end if
3809 else if (wave_speeds == wave_speeds_pressure) then
3810 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3811
3812 pres_sr = pres_sl
3813
3814 ! Low Mach correction: Thornber et al. JCP (2008)
3815 ms_l = max(1._wp, &
3816 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3817 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3818 ms_r = max(1._wp, &
3819 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3820 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3821
3822 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3823 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3824
3825 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3826 end if
3827
3828 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3829 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3830
3831 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3832 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3833 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3834 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3835 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3836
3837 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3838 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
3839 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
3840
3841 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
3842 xi_mp = -min(0._wp, sign(1._wp, s_l))
3843 xi_pp = max(0._wp, sign(1._wp, s_r))
3844
3845 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 &
3846 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
3847 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
3848 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
3849 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
3850
3851 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))
3852
3853 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 &
3854 & - vel_r(dir_idx(1)))
3855
3856 ! Low Mach correction
3857 if (low_mach == 1) then
3858 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3859# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3860 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3861# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3862 pcorr = 0._wp
3863# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3864
3865# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3866 if (low_mach == 1) then
3867# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3868 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3869# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3870 end if
3871# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3872 else if (riemann_solver == riemann_solver_hllc) then
3873# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3874 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3875# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3876 pcorr = 0._wp
3877# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3878
3879# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3880 if (low_mach == 1) then
3881# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3882 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))) &
3883# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3884 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3885# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3886 else if (low_mach == 2) then
3887# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3888 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))))
3889# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3890 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))))
3891# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3892 vel_l(dir_idx(1)) = vel_l_tmp
3893# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3894 vel_r(dir_idx(1)) = vel_r_tmp
3895# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3896 end if
3897# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3898 end if
3899 else
3900 pcorr = 0._wp
3901 end if
3902
3903 ! COMPUTING FLUXES MASS FLUX.
3904
3905# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3906#if defined(MFC_OpenACC)
3907# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3908!$acc loop seq
3909# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3910#elif defined(MFC_OpenMP)
3911# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3912
3913# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3914#endif
3915 do i = 1, eqn_idx%cont%end
3916 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3917 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3918 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3919 end do
3920
3921 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
3922
3923# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3924#if defined(MFC_OpenACC)
3925# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3926!$acc loop seq
3927# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3928#elif defined(MFC_OpenMP)
3929# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3930
3931# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3932#endif
3933 do i = 1, num_dims
3934 flux_rsx_vf(j, k, l, &
3935 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
3936 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
3937 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
3938 & *dir_flg(dir_idx(i))*pcorr
3939 end do
3940
3941 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3942 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
3943
3944 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
3945 if (elasticity) then
3946 flux_ene_e = 0._wp
3947
3948# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3949#if defined(MFC_OpenACC)
3950# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3951!$acc loop seq
3952# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3953#elif defined(MFC_OpenMP)
3954# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3955
3956# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3957#endif
3958 do i = 1, num_dims
3959 ! MOMENTUM ELASTIC FLUX.
3960 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
3961 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
3962 & - xi_p*tau_e_r(dir_idx_tau(i))
3963 ! ENERGY ELASTIC FLUX.
3964 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
3965 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
3966 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
3967 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
3968 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
3969 end do
3970 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
3971 end if
3972
3973 ! VOLUME FRACTION FLUX.
3974
3975# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3976#if defined(MFC_OpenACC)
3977# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3978!$acc loop seq
3979# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3980#elif defined(MFC_OpenMP)
3981# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3982
3983# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3984#endif
3985 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3986 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3987 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
3988 end do
3989
3990 ! Advection velocity source: interface velocity for volume fraction transport
3991
3992# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3993#if defined(MFC_OpenACC)
3994# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3995!$acc loop seq
3996# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3997#elif defined(MFC_OpenMP)
3998# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3999
4000# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4001#endif
4002 do i = 1, num_dims
4003 vel_src_rsx_vf(j, k, l, &
4004 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4005 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
4006 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
4007 end do
4008
4009 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
4010 ! energy flux
4011
4012# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4013#if defined(MFC_OpenACC)
4014# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4015!$acc loop seq
4016# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4017#elif defined(MFC_OpenMP)
4018# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4019
4020# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4021#endif
4022 do i = 1, num_fluids
4023 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
4024 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
4025 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
4026 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
4027 & + pres_r)
4028
4029 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
4030 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4031 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
4032 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
4033 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4034 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
4035 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
4036 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4037 & i + eqn_idx%adv%beg - 1))
4038 end do
4039
4040 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4041
4042 ! HYPOELASTIC STRESS EVOLUTION FLUX.
4043 if (hypoelasticity) then
4044
4045# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4046#if defined(MFC_OpenACC)
4047# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4048!$acc loop seq
4049# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4050#elif defined(MFC_OpenMP)
4051# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4052
4053# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4054#endif
4055 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4056 flux_rsx_vf(j, k, l, &
4057 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
4058 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
4059 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
4060 end do
4061 end if
4062
4063 ! Hyperelastic reference map flux for material deformation tracking
4064 if (hyperelasticity) then
4065
4066# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4067#if defined(MFC_OpenACC)
4068# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4069!$acc loop seq
4070# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4071#elif defined(MFC_OpenMP)
4072# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4073
4074# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4075#endif
4076 do i = 1, num_dims
4077 flux_rsx_vf(j, k, l, &
4078 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
4079 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
4080 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
4081 end do
4082 end if
4083
4084 ! COLOR FUNCTION FLUX
4085 if (surface_tension) then
4086 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
4087 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
4088 end if
4089
4090 ! Geometrical source flux for cylindrical coordinates
4091# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4092 if (cyl_coord) then
4093 ! Substituting the advective flux into the inviscid geometrical source flux
4094
4095# 518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4096#if defined(MFC_OpenACC)
4097# 518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4098!$acc loop seq
4099# 518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4100#elif defined(MFC_OpenMP)
4101# 518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4102
4103# 518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4104#endif
4105 do i = 1, eqn_idx%E
4106 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4107 end do
4108
4109# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4110#if defined(MFC_OpenACC)
4111# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4112!$acc loop seq
4113# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4114#elif defined(MFC_OpenMP)
4115# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4116
4117# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4118#endif
4119 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
4120 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4121 end do
4122 ! Recalculating the radial momentum geometric source flux
4123 flux_gsrc_rsx_vf(j, k, l, &
4124 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
4125 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
4126 ! Geometrical source of the void fraction(s) is zero
4127
4128# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4129#if defined(MFC_OpenACC)
4130# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4131!$acc loop seq
4132# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4133#elif defined(MFC_OpenMP)
4134# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4135
4136# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4137#endif
4138 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4139 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4140 end do
4141 end if
4142# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4143# 550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4144 end do
4145 end do
4146 end do
4147
4148# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4149#if defined(MFC_OpenACC)
4150# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4151!$acc end parallel loop
4152# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4153#elif defined(MFC_OpenMP)
4154# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4155
4156# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4157!$omp end target teams loop
4158# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4159#endif
4160 else if (model_eqns == model_eqns_4eq) then
4161 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
4162
4163# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4164
4165# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4166#if defined(MFC_OpenACC)
4167# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4168!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, 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)
4169# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4170#elif defined(MFC_OpenMP)
4171# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4172
4173# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4174
4175# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4176
4177# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4178!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, 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)
4179# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4180#endif
4181# 565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4182 do l = is3%beg, is3%end
4183 do k = is1%beg, is1%end
4184 do j = is2%beg, is2%end
4185 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4186 rho_l = 0._wp; rho_r = 0._wp
4187 gamma_l = 0._wp; gamma_r = 0._wp
4188 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4189 qv_l = 0._wp; qv_r = 0._wp
4190
4191
4192# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4193#if defined(MFC_OpenACC)
4194# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4195!$acc loop seq
4196# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4197#elif defined(MFC_OpenMP)
4198# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4199
4200# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4201#endif
4202 do i = 1, eqn_idx%cont%end
4203 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4204 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4205 end do
4206
4207
4208# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4209#if defined(MFC_OpenACC)
4210# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4211!$acc loop seq
4212# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4213#elif defined(MFC_OpenMP)
4214# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4215
4216# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4217#endif
4218 do i = 1, num_dims
4219 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4220 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4221 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4222 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4223 end do
4224
4225
4226# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4227#if defined(MFC_OpenACC)
4228# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4229!$acc loop seq
4230# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4231#elif defined(MFC_OpenMP)
4232# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4233
4234# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4235#endif
4236 do i = 1, num_fluids
4237 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4238 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4239 end do
4240
4241# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4242#if defined(MFC_OpenACC)
4243# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4244!$acc loop seq
4245# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4246#elif defined(MFC_OpenMP)
4247# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4248
4249# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4250#endif
4251 do i = 1, num_fluids
4252 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4253 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4254 end do
4255
4256
4257# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4258#if defined(MFC_OpenACC)
4259# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4260!$acc loop seq
4261# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4262#elif defined(MFC_OpenMP)
4263# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4264
4265# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4266#endif
4267 do i = 1, num_fluids
4268 rho_l = rho_l + alpha_rho_l(i)
4269 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4270 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4271 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4272
4273 rho_r = rho_r + alpha_rho_r(i)
4274 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4275 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4276 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4277 end do
4278
4279 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4280 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4281
4282 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
4283 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
4284
4285 h_l = (e_l + pres_l)/rho_l
4286 h_r = (e_r + pres_r)/rho_r
4287
4288 if (avg_state == avg_state_roe) then
4289# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4290 rho_avg = sqrt(rho_l*rho_r)
4291# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4292
4293# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4294 vel_avg_rms = 0._wp
4295# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4296
4297# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4298
4299# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4300#if defined(MFC_OpenACC)
4301# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4302!$acc loop seq
4303# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4304#elif defined(MFC_OpenMP)
4305# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4306
4307# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4308#endif
4309# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4310 do i = 1, num_vels
4311# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4312 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
4313# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4314 end do
4315# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4316
4317# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4318 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
4319# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4320
4321# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4322 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
4323# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4324
4325# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4326 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
4327# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4328
4329# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4330 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
4331# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4332
4333# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4334 if (chemistry) then
4335# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4336 eps = 0.001_wp
4337# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4338 call get_species_enthalpies_rt(t_l, h_il)
4339# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4340 call get_species_enthalpies_rt(t_r, h_ir)
4341# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4342 h_il = h_il*gas_constant/molecular_weights*t_l
4343# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4344 h_ir = h_ir*gas_constant/molecular_weights*t_r
4345# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4346 call get_species_specific_heats_r(t_l, cp_il)
4347# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4348 call get_species_specific_heats_r(t_r, cp_ir)
4349# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4350
4351# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4352 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
4353# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4354 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
4355# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4356 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
4357# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4358 if (abs(t_l - t_r) < eps) then
4359# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4360 ! Case when T_L and T_R are very close
4361# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4362 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
4363# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4364 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
4365# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4366 & - gas_constant/molecular_weights(:)))
4367# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4368 else
4369# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4370 ! Normal calculation when T_L and T_R are sufficiently different
4371# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4372 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
4373# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4374 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
4375# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4376 end if
4377# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4378 gamma_avg = cp_avg/cv_avg
4379# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4380
4381# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4382 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
4383# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4384 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
4385# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4386 end if
4387# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4388 end if
4389# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4390
4391# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4392 if (avg_state == avg_state_arithmetic) then
4393# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4394 rho_avg = 5.e-1_wp*(rho_l + rho_r)
4395# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4396 vel_avg_rms = 0._wp
4397# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4398
4399# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4400#if defined(MFC_OpenACC)
4401# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4402!$acc loop seq
4403# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4404#elif defined(MFC_OpenMP)
4405# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4406
4407# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4408#endif
4409# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4410 do i = 1, num_vels
4411# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4412 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
4413# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4414 end do
4415# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4416
4417# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4418 h_avg = 5.e-1_wp*(h_l + h_r)
4419# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4420 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
4421# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4422 qv_avg = 5.e-1_wp*(qv_l + qv_r)
4423# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4424 end if
4425
4426 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
4427 & c_l, qv_l)
4428
4429 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
4430 & c_r, qv_r)
4431
4432 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
4433 ! variables are placeholders to call the subroutine.
4434
4435 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
4436 & 0._wp, c_avg, qv_avg)
4437
4438 if (wave_speeds == wave_speeds_direct) then
4439 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
4440 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
4441
4442 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
4443 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
4444 & - rho_r*(s_r - vel_r(dir_idx(1))))
4445 else if (wave_speeds == wave_speeds_pressure) then
4446 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4447
4448 pres_sr = pres_sl
4449
4450 ! Low Mach correction: Thornber et al. JCP (2008)
4451 ms_l = max(1._wp, &
4452 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
4453 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
4454 ms_r = max(1._wp, &
4455 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
4456 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
4457
4458 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4459 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4460
4461 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4462 end if
4463
4464 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4465 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4466
4467 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4468 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4469 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4470 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4471 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4472
4473 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4474 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4475 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4476
4477
4478# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4479#if defined(MFC_OpenACC)
4480# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4481!$acc loop seq
4482# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4483#elif defined(MFC_OpenMP)
4484# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4485
4486# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4487#endif
4488 do i = 1, eqn_idx%cont%end
4489 flux_rsx_vf(j, k, l, &
4490 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
4491 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4492 end do
4493
4494 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4495
4496# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4497#if defined(MFC_OpenACC)
4498# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4499!$acc loop seq
4500# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4501#elif defined(MFC_OpenMP)
4502# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4503
4504# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4505#endif
4506 do i = 1, num_dims
4507 flux_rsx_vf(j, k, l, &
4508 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
4509 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4510 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
4511 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4512 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4513 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
4514 end do
4515
4516 if (bubbles_euler) then
4517 ! Put p_tilde in
4518
4519# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4520#if defined(MFC_OpenACC)
4521# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4522!$acc loop seq
4523# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4524#elif defined(MFC_OpenMP)
4525# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4526
4527# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4528#endif
4529 do i = 1, num_dims
4530 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
4531 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
4532 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
4533 end do
4534 end if
4535
4536 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
4537
4538
4539# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4540#if defined(MFC_OpenACC)
4541# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4542!$acc loop seq
4543# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4544#elif defined(MFC_OpenMP)
4545# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4546
4547# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4548#endif
4549 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
4550 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4551 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4552 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4553 end do
4554
4555 ! Advection velocity source: interface velocity for volume fraction transport
4556
4557# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4558#if defined(MFC_OpenACC)
4559# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4560!$acc loop seq
4561# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4562#elif defined(MFC_OpenMP)
4563# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4564
4565# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4566#endif
4567 do i = 1, num_dims
4568 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
4569 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
4570 end do
4571
4572 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4573
4574 ! Add advection flux for bubble variables
4575 if (bubbles_euler) then
4576
4577# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4578#if defined(MFC_OpenACC)
4579# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4580!$acc loop seq
4581# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4582#elif defined(MFC_OpenMP)
4583# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4584
4585# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4586#endif
4587 do i = eqn_idx%bub%beg, eqn_idx%bub%end
4588 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
4589 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4590 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, &
4591 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4592 end do
4593 end if
4594
4595 ! Geometrical source flux for cylindrical coordinates
4596
4597# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4598 if (cyl_coord) then
4599 ! Substituting the advective flux into the inviscid geometrical source flux
4600
4601# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4602#if defined(MFC_OpenACC)
4603# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4604!$acc loop seq
4605# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4606#elif defined(MFC_OpenMP)
4607# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4608
4609# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4610#endif
4611 do i = 1, eqn_idx%E
4612 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4613 end do
4614 ! Recalculating the radial momentum geometric source flux
4615 flux_gsrc_rsx_vf(j, k, l, &
4616 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
4617 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
4618 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
4619 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
4620 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
4621 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
4622 ! Geometrical source of the void fraction(s) is zero
4623
4624# 750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4625#if defined(MFC_OpenACC)
4626# 750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4627!$acc loop seq
4628# 750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4629#elif defined(MFC_OpenMP)
4630# 750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4631
4632# 750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4633#endif
4634 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4635 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4636 end do
4637 end if
4638# 756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4639# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4640 end do
4641 end do
4642 end do
4643
4644# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4645#if defined(MFC_OpenACC)
4646# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4647!$acc end parallel loop
4648# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4649#elif defined(MFC_OpenMP)
4650# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4651
4652# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4653!$omp end target teams loop
4654# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4655#endif
4656 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
4657 ! 5-equation model with Euler-Euler bubble dynamics
4658
4659# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4660
4661# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4662#if defined(MFC_OpenACC)
4663# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4664!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
4665# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4666#elif defined(MFC_OpenMP)
4667# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4668
4669# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4670
4671# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4672
4673# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4674!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
4675# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4676#endif
4677# 786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4678 do l = is3%beg, is3%end
4679 do k = is1%beg, is1%end
4680 do j = is2%beg, is2%end
4681 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4682 rho_l = 0._wp; rho_r = 0._wp
4683 gamma_l = 0._wp; gamma_r = 0._wp
4684 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4685 qv_l = 0._wp; qv_r = 0._wp
4686
4687
4688# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4689#if defined(MFC_OpenACC)
4690# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4691!$acc loop seq
4692# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4693#elif defined(MFC_OpenMP)
4694# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4695
4696# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4697#endif
4698 do i = 1, num_fluids
4699 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4700 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4701 end do
4702
4703 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4704
4705
4706# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4707#if defined(MFC_OpenACC)
4708# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4709!$acc loop seq
4710# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4711#elif defined(MFC_OpenMP)
4712# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4713
4714# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4715#endif
4716 do i = 1, num_dims
4717 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4718 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4719 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4720 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4721 end do
4722
4723 ! Retain this in the refactor
4724 if (mpp_lim .and. (num_fluids > 2)) then
4725
4726# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4727#if defined(MFC_OpenACC)
4728# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4729!$acc loop seq
4730# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4731#elif defined(MFC_OpenMP)
4732# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4733
4734# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4735#endif
4736 do i = 1, num_fluids
4737 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
4738 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
4739 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
4740 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
4741 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
4742 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
4743 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
4744 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
4745 end do
4746 else if (num_fluids > 2) then
4747
4748# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4749#if defined(MFC_OpenACC)
4750# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4751!$acc loop seq
4752# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4753#elif defined(MFC_OpenMP)
4754# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4755
4756# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4757#endif
4758 do i = 1, num_fluids - 1
4759 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
4760 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
4761 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
4762 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
4763 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
4764 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
4765 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
4766 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
4767 end do
4768 else
4769 rho_l = ql_prim_rsx_vf(j, k, l, 1)
4770 gamma_l = gammas(1)
4771 pi_inf_l = pi_infs(1)
4772 qv_l = qvs(1)
4773 rho_r = qr_prim_rsx_vf(j, k + 1, l, 1)
4774 gamma_r = gammas(1)
4775 pi_inf_r = pi_infs(1)
4776 qv_r = qvs(1)
4777 end if
4778
4779 if (viscous) then
4780 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
4781
4782# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4783#if defined(MFC_OpenACC)
4784# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4785!$acc loop seq
4786# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4787#elif defined(MFC_OpenMP)
4788# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4789
4790# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4791#endif
4792 do i = 1, 2
4793 re_l(i) = dflt_real
4794 re_r(i) = dflt_real
4795
4796 if (re_size(i) > 0) re_l(i) = 0._wp
4797 if (re_size(i) > 0) re_r(i) = 0._wp
4798
4799
4800# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4801#if defined(MFC_OpenACC)
4802# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4803!$acc loop seq
4804# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4805#elif defined(MFC_OpenMP)
4806# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4807
4808# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4809#endif
4810 do q = 1, re_size(i)
4811 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
4812 & q)))/res_gs(i, q) + re_l(i)
4813 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
4814 & q)))/res_gs(i, q) + re_r(i)
4815 end do
4816
4817 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4818 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4819 end do
4820 end if
4821 end if
4822
4823 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4824 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4825
4826 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
4827 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
4828
4829 h_l = (e_l + pres_l)/rho_l
4830 h_r = (e_r + pres_r)/rho_r
4831
4832 if (avg_state == avg_state_arithmetic) then
4833
4834# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4835#if defined(MFC_OpenACC)
4836# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4837!$acc loop seq
4838# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4839#elif defined(MFC_OpenMP)
4840# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4841
4842# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4843#endif
4844 do i = 1, nb
4845 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
4846 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
4847
4848 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
4849 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
4850 if (.not. polytropic .and. .not. qbmm) then
4851 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
4852 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
4853 end if
4854 end do
4855
4856 if (.not. qbmm) then
4857 if (adv_n) then
4858 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
4859 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
4860 else
4861 nbub_l = 0._wp
4862 nbub_r = 0._wp
4863
4864# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4865#if defined(MFC_OpenACC)
4866# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4867!$acc loop seq
4868# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4869#elif defined(MFC_OpenMP)
4870# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4871
4872# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4873#endif
4874 do i = 1, nb
4875 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
4876 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
4877 end do
4878
4879 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
4880 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
4881 & eqn_idx%E + num_fluids)/nbub_r
4882 end if
4883 else
4884 ! nb stored in 0th moment of first R0 bin in variable conversion module
4885 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
4886 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
4887 end if
4888
4889
4890# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4891#if defined(MFC_OpenACC)
4892# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4893!$acc loop seq
4894# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4895#elif defined(MFC_OpenMP)
4896# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4897
4898# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4899#endif
4900 do i = 1, nb
4901 if (.not. qbmm) then
4902 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
4903 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
4904 end if
4905 end do
4906
4907 if (qbmm) then
4908 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
4909 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
4910
4911 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
4912 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
4913
4914 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
4915 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
4916 else
4917 pbwr3lbar = 0._wp
4918 pbwr3rbar = 0._wp
4919
4920 r3lbar = 0._wp
4921 r3rbar = 0._wp
4922
4923 r3v2lbar = 0._wp
4924 r3v2rbar = 0._wp
4925
4926
4927# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4928#if defined(MFC_OpenACC)
4929# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4930!$acc loop seq
4931# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4932#elif defined(MFC_OpenMP)
4933# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4934
4935# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4936#endif
4937 do i = 1, nb
4938 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
4939 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
4940
4941 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
4942 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
4943
4944 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
4945 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
4946 end do
4947 end if
4948
4949 rho_avg = 5.e-1_wp*(rho_l + rho_r)
4950 h_avg = 5.e-1_wp*(h_l + h_r)
4951 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
4952 qv_avg = 5.e-1_wp*(qv_l + qv_r)
4953 vel_avg_rms = 0._wp
4954
4955
4956# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4957#if defined(MFC_OpenACC)
4958# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4959!$acc loop seq
4960# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4961#elif defined(MFC_OpenMP)
4962# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4963
4964# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4965#endif
4966 do i = 1, num_dims
4967 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
4968 end do
4969 end if
4970
4971 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
4972 & c_l, qv_l)
4973
4974 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
4975 & c_r, qv_r)
4976
4977 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
4978 ! variables are placeholders to call the subroutine.
4979 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
4980 & 0._wp, c_avg, qv_avg)
4981
4982 if (viscous) then
4983
4984# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4985#if defined(MFC_OpenACC)
4986# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4987!$acc loop seq
4988# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4989#elif defined(MFC_OpenMP)
4990# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4991
4992# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4993#endif
4994 do i = 1, 2
4995 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
4996 end do
4997 end if
4998
4999 ! Low Mach correction
5000 if (low_mach == 2) then
5001 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5002# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5003 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5004# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5005 pcorr = 0._wp
5006# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5007
5008# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5009 if (low_mach == 1) then
5010# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5011 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5012# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5013 end if
5014# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5015 else if (riemann_solver == riemann_solver_hllc) then
5016# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5017 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5018# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5019 pcorr = 0._wp
5020# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5021
5022# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5023 if (low_mach == 1) then
5024# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5025 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))) &
5026# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5027 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5028# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5029 else if (low_mach == 2) then
5030# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5031 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))))
5032# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5033 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))))
5034# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5035 vel_l(dir_idx(1)) = vel_l_tmp
5036# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5037 vel_r(dir_idx(1)) = vel_r_tmp
5038# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5039 end if
5040# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5041 end if
5042 end if
5043
5044 if (wave_speeds == wave_speeds_direct) then
5045 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5046 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5047
5048 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5049 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
5050 & - rho_r*(s_r - vel_r(dir_idx(1))))
5051 else if (wave_speeds == wave_speeds_pressure) then
5052 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5053
5054 pres_sr = pres_sl
5055
5056 ! Low Mach correction: Thornber et al. JCP (2008)
5057 ms_l = max(1._wp, &
5058 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
5059 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
5060 ms_r = max(1._wp, &
5061 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
5062 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
5063
5064 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5065 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5066
5067 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5068 end if
5069
5070 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5071 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5072
5073 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5074 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5075 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5076 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5077 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5078
5079 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5080 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5081 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5082
5083 ! Low Mach correction
5084 if (low_mach == 1) then
5085 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5086# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5087 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5088# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5089 pcorr = 0._wp
5090# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5091
5092# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5093 if (low_mach == 1) then
5094# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5095 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5096# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5097 end if
5098# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5099 else if (riemann_solver == riemann_solver_hllc) then
5100# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5101 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5102# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5103 pcorr = 0._wp
5104# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5105
5106# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5107 if (low_mach == 1) then
5108# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5109 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))) &
5110# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5111 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5112# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5113 else if (low_mach == 2) then
5114# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5115 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))))
5116# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5117 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))))
5118# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5119 vel_l(dir_idx(1)) = vel_l_tmp
5120# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5121 vel_r(dir_idx(1)) = vel_r_tmp
5122# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5123 end if
5124# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5125 end if
5126 else
5127 pcorr = 0._wp
5128 end if
5129
5130
5131# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5132#if defined(MFC_OpenACC)
5133# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5134!$acc loop seq
5135# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5136#elif defined(MFC_OpenMP)
5137# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5138
5139# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5140#endif
5141 do i = 1, eqn_idx%cont%end
5142 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5143 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5144 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5145 end do
5146
5147 if (bubbles_euler .and. (num_fluids > 1)) then
5148 ! Kill mass transport @ gas density
5149 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5150 end if
5151
5152 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
5153
5154 ! Include p_tilde
5155
5156 if (avg_state == avg_state_arithmetic) then
5157 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
5158 pres_l = pres_l - alpha_l(num_fluids)*pres_l
5159 else
5160 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
5161 end if
5162
5163 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
5164 pres_r = pres_r - alpha_r(num_fluids)*pres_r
5165 else
5166 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
5167 end if
5168 end if
5169
5170
5171# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5172#if defined(MFC_OpenACC)
5173# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5174!$acc loop seq
5175# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5176#elif defined(MFC_OpenMP)
5177# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5178
5179# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5180#endif
5181 do i = 1, num_dims
5182 flux_rsx_vf(j, k, l, &
5183 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
5184 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
5185 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
5186 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5187 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
5188 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
5189 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
5190 end do
5191
5192 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
5193 flux_rsx_vf(j, k, l, &
5194 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
5195 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
5196 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
5197 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
5198 & *pcorr*s_s
5199
5200 ! Volume fraction flux
5201
5202# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5203#if defined(MFC_OpenACC)
5204# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5205!$acc loop seq
5206# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5207#elif defined(MFC_OpenMP)
5208# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5209
5210# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5211#endif
5212 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5213 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5214 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5215 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5216 end do
5217
5218 ! Advection velocity source: interface velocity for volume fraction transport
5219
5220# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5221#if defined(MFC_OpenACC)
5222# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5223!$acc loop seq
5224# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5225#elif defined(MFC_OpenMP)
5226# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5227
5228# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5229#endif
5230 do i = 1, num_dims
5231 vel_src_rsx_vf(j, k, l, &
5232 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
5233 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
5234
5235 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
5236 end do
5237
5238 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5239
5240 ! Add advection flux for bubble variables
5241
5242# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5243#if defined(MFC_OpenACC)
5244# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5245!$acc loop seq
5246# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5247#elif defined(MFC_OpenMP)
5248# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5249
5250# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5251#endif
5252 do i = eqn_idx%bub%beg, eqn_idx%bub%end
5253 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
5254 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5255 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5256 end do
5257
5258 if (qbmm) then
5259 flux_rsx_vf(j, k, l, &
5260 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5261 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5262 end if
5263
5264 if (adv_n) then
5265 flux_rsx_vf(j, k, l, &
5266 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5267 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5268 end if
5269
5270 ! Geometrical source flux for cylindrical coordinates
5271# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5272 if (cyl_coord) then
5273 ! Substituting the advective flux into the inviscid geometrical source flux
5274
5275# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5276#if defined(MFC_OpenACC)
5277# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5278!$acc loop seq
5279# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5280#elif defined(MFC_OpenMP)
5281# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5282
5283# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5284#endif
5285 do i = 1, eqn_idx%E
5286 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5287 end do
5288 ! Recalculating the radial momentum geometric source flux
5289 flux_gsrc_rsx_vf(j, k, l, &
5290 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
5291 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
5292 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
5293 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
5294 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
5295 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
5296 ! Geometrical source of the void fraction(s) is zero
5297
5298# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5299#if defined(MFC_OpenACC)
5300# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5301!$acc loop seq
5302# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5303#elif defined(MFC_OpenMP)
5304# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5305
5306# 1145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5307#endif
5308 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5309 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5310 end do
5311 end if
5312# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5313# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5314 end do
5315 end do
5316 end do
5317
5318# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5319#if defined(MFC_OpenACC)
5320# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5321!$acc end parallel loop
5322# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5323#elif defined(MFC_OpenMP)
5324# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5325
5326# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5327!$omp end target teams loop
5328# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5329#endif
5330 else
5331 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
5332
5333# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5334
5335# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5336#if defined(MFC_OpenACC)
5337# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5338!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, 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, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
5339# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5340#elif defined(MFC_OpenMP)
5341# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5342
5343# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5344
5345# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5346
5347# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5348!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, 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, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
5349# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5350#endif
5351# 1183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5352 do l = is3%beg, is3%end
5353 do k = is1%beg, is1%end
5354 do j = is2%beg, is2%end
5355 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5356 rho_l = 0._wp; rho_r = 0._wp
5357 gamma_l = 0._wp; gamma_r = 0._wp
5358 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5359 qv_l = 0._wp; qv_r = 0._wp
5360 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
5361
5362
5363# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5364#if defined(MFC_OpenACC)
5365# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5366!$acc loop seq
5367# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5368#elif defined(MFC_OpenMP)
5369# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5370
5371# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5372#endif
5373 do i = 1, num_fluids
5374 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5375 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5376 end do
5377
5378
5379# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5380#if defined(MFC_OpenACC)
5381# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5382!$acc loop seq
5383# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5384#elif defined(MFC_OpenMP)
5385# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5386
5387# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5388#endif
5389 do i = 1, num_dims
5390 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5391 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
5392 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5393 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5394 end do
5395
5396 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5397 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
5398
5399 ! Change this by splitting it into the cases present in the bubbles_euler
5400 if (mpp_lim) then
5401
5402# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5403#if defined(MFC_OpenACC)
5404# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5405!$acc loop seq
5406# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5407#elif defined(MFC_OpenMP)
5408# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5409
5410# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5411#endif
5412 do i = 1, num_fluids
5413 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5414 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5415 & eqn_idx%E + i)), 1._wp)
5416 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
5417 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
5418 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
5419 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5420 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5421 end do
5422
5423
5424# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5425#if defined(MFC_OpenACC)
5426# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5427!$acc loop seq
5428# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5429#elif defined(MFC_OpenMP)
5430# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5431
5432# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5433#endif
5434 do i = 1, num_fluids
5435 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5436 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5437 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
5438 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5439 end do
5440 end if
5441
5442
5443# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5444#if defined(MFC_OpenACC)
5445# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5446!$acc loop seq
5447# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5448#elif defined(MFC_OpenMP)
5449# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5450
5451# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5452#endif
5453 do i = 1, num_fluids
5454 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
5455 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
5456 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
5457 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
5458
5459 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
5460 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
5461 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
5462 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
5463 end do
5464
5465 re_max = 0
5466 if (re_size(1) > 0) re_max = 1
5467 if (re_size(2) > 0) re_max = 2
5468
5469 if (viscous) then
5470
5471# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5472#if defined(MFC_OpenACC)
5473# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5474!$acc loop seq
5475# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5476#elif defined(MFC_OpenMP)
5477# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5478
5479# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5480#endif
5481 do i = 1, re_max
5482 re_l(i) = 0._wp
5483 re_r(i) = 0._wp
5484
5485
5486# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5487#if defined(MFC_OpenACC)
5488# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5489!$acc loop seq
5490# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5491#elif defined(MFC_OpenMP)
5492# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5493
5494# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5495#endif
5496 do q = 1, re_size(i)
5497 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
5498 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
5499 end do
5500
5501 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5502 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5503 end do
5504 end if
5505
5506 if (chemistry) then
5507 c_sum_yi_phi = 0.0_wp
5508
5509# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5510#if defined(MFC_OpenACC)
5511# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5512!$acc loop seq
5513# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5514#elif defined(MFC_OpenMP)
5515# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5516
5517# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5518#endif
5519 do i = eqn_idx%species%beg, eqn_idx%species%end
5520 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5521 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
5522 end do
5523
5524 call get_mixture_molecular_weight(ys_l, mw_l)
5525 call get_mixture_molecular_weight(ys_r, mw_r)
5526
5527 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5528 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5529
5530 r_gas_l = gas_constant/mw_l
5531 r_gas_r = gas_constant/mw_r
5532
5533 t_l = pres_l/rho_l/r_gas_l
5534 t_r = pres_r/rho_r/r_gas_r
5535
5536 call get_species_specific_heats_r(t_l, cp_il)
5537 call get_species_specific_heats_r(t_r, cp_ir)
5538
5539 if (chem_params%gamma_method == 1) then
5540 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5541 gamma_il = cp_il/(cp_il - 1.0_wp)
5542 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5543
5544 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5545 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5546 else if (chem_params%gamma_method == 2) then
5547 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5548 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5549 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5550 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5551 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5552
5553 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
5554 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5555 end if
5556
5557 call get_mixture_energy_mass(t_l, ys_l, e_l)
5558 call get_mixture_energy_mass(t_r, ys_r, e_r)
5559
5560 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5561 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5562 h_l = (e_l + pres_l)/rho_l
5563 h_r = (e_r + pres_r)/rho_r
5564 else
5565 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5566 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5567
5568 h_l = (e_l + pres_l)/rho_l
5569 h_r = (e_r + pres_r)/rho_r
5570 end if
5571
5572 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
5573 if (hypoelasticity) then
5574
5575# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5576#if defined(MFC_OpenACC)
5577# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5578!$acc loop seq
5579# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5580#elif defined(MFC_OpenMP)
5581# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5582
5583# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5584#endif
5585 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5586 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5587 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
5588 end do
5589 g_l = 0._wp
5590 g_r = 0._wp
5591
5592# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5593#if defined(MFC_OpenACC)
5594# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5595!$acc loop seq
5596# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5597#elif defined(MFC_OpenMP)
5598# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5599
5600# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5601#endif
5602 do i = 1, num_fluids
5603 g_l = g_l + alpha_l(i)*gs_rs(i)
5604 g_r = g_r + alpha_r(i)*gs_rs(i)
5605 end do
5606
5607# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5608#if defined(MFC_OpenACC)
5609# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5610!$acc loop seq
5611# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5612#elif defined(MFC_OpenMP)
5613# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5614
5615# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5616#endif
5617 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5618 ! Elastic contribution to energy if G large enough
5619 if ((g_l > verysmall) .and. (g_r > verysmall)) then
5620 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5621 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5622 ! Additional terms in 2D and 3D
5623 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
5624 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5625 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5626 end if
5627 end if
5628 end do
5629 end if
5630
5631 ! Hyperelastic stress contribution: strain energy added to total energy
5632 if (hyperelasticity) then
5633
5634# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5635#if defined(MFC_OpenACC)
5636# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5637!$acc loop seq
5638# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5639#elif defined(MFC_OpenMP)
5640# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5641
5642# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5643#endif
5644 do i = 1, num_dims
5645 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
5646 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
5647 end do
5648 g_l = 0._wp
5649 g_r = 0._wp
5650
5651# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5652#if defined(MFC_OpenACC)
5653# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5654!$acc loop seq
5655# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5656#elif defined(MFC_OpenMP)
5657# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5658
5659# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5660#endif
5661 do i = 1, num_fluids
5662 ! Mixture left and right shear modulus
5663 g_l = g_l + alpha_l(i)*gs_rs(i)
5664 g_r = g_r + alpha_r(i)*gs_rs(i)
5665 end do
5666 ! Elastic contribution to energy if G large enough
5667 if (g_l > verysmall .and. g_r > verysmall) then
5668 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
5669 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
5670 end if
5671
5672# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5673#if defined(MFC_OpenACC)
5674# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5675!$acc loop seq
5676# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5677#elif defined(MFC_OpenMP)
5678# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5679
5680# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5681#endif
5682 do i = 1, b_size - 1
5683 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5684 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
5685 end do
5686 end if
5687
5688 h_l = (e_l + pres_l)/rho_l
5689 h_r = (e_r + pres_r)/rho_r
5690
5691 if (avg_state == avg_state_roe) then
5692# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5693 rho_avg = sqrt(rho_l*rho_r)
5694# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5695
5696# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5697 vel_avg_rms = 0._wp
5698# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5699
5700# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5701
5702# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5703#if defined(MFC_OpenACC)
5704# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5705!$acc loop seq
5706# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5707#elif defined(MFC_OpenMP)
5708# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5709
5710# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5711#endif
5712# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5713 do i = 1, num_vels
5714# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5715 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
5716# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5717 end do
5718# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5719
5720# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5721 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
5722# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5723
5724# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5725 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
5726# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5727
5728# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5729 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
5730# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5731
5732# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5733 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
5734# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5735
5736# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5737 if (chemistry) then
5738# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5739 eps = 0.001_wp
5740# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5741 call get_species_enthalpies_rt(t_l, h_il)
5742# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5743 call get_species_enthalpies_rt(t_r, h_ir)
5744# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5745 h_il = h_il*gas_constant/molecular_weights*t_l
5746# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5747 h_ir = h_ir*gas_constant/molecular_weights*t_r
5748# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5749 call get_species_specific_heats_r(t_l, cp_il)
5750# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5751 call get_species_specific_heats_r(t_r, cp_ir)
5752# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5753
5754# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5755 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
5756# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5757 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
5758# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5759 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
5760# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5761 if (abs(t_l - t_r) < eps) then
5762# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5763 ! Case when T_L and T_R are very close
5764# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5765 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
5766# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5767 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
5768# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5769 & - gas_constant/molecular_weights(:)))
5770# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5771 else
5772# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5773 ! Normal calculation when T_L and T_R are sufficiently different
5774# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5775 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
5776# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5777 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
5778# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5779 end if
5780# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5781 gamma_avg = cp_avg/cv_avg
5782# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5783
5784# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5785 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
5786# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5787 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
5788# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5789 end if
5790# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5791 end if
5792# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5793
5794# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5795 if (avg_state == avg_state_arithmetic) then
5796# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5797 rho_avg = 5.e-1_wp*(rho_l + rho_r)
5798# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5799 vel_avg_rms = 0._wp
5800# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5801
5802# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5803#if defined(MFC_OpenACC)
5804# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5805!$acc loop seq
5806# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5807#elif defined(MFC_OpenMP)
5808# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5809
5810# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5811#endif
5812# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5813 do i = 1, num_vels
5814# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5815 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
5816# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5817 end do
5818# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5819
5820# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5821 h_avg = 5.e-1_wp*(h_l + h_r)
5822# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5823 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
5824# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5825 qv_avg = 5.e-1_wp*(qv_l + qv_r)
5826# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5827 end if
5828
5829 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
5830 & c_l, qv_l)
5831
5832 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
5833 & c_r, qv_r)
5834
5835 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
5836 ! variables are placeholders to call the subroutine.
5837 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
5838 & c_sum_yi_phi, c_avg, qv_avg)
5839
5840 if (viscous) then
5841 if (chemistry) then
5842 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
5843 end if
5844
5845# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5846#if defined(MFC_OpenACC)
5847# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5848!$acc loop seq
5849# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5850#elif defined(MFC_OpenMP)
5851# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5852
5853# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5854#endif
5855 do i = 1, 2
5856 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5857 end do
5858 end if
5859
5860 ! Low Mach correction
5861 if (low_mach == 2) then
5862 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5863# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5864 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5865# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5866 pcorr = 0._wp
5867# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5868
5869# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5870 if (low_mach == 1) then
5871# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5872 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5873# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5874 end if
5875# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5876 else if (riemann_solver == riemann_solver_hllc) then
5877# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5878 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5879# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5880 pcorr = 0._wp
5881# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5882
5883# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5884 if (low_mach == 1) then
5885# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5886 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))) &
5887# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5888 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5889# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5890 else if (low_mach == 2) then
5891# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5892 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))))
5893# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5894 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))))
5895# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5896 vel_l(dir_idx(1)) = vel_l_tmp
5897# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5898 vel_r(dir_idx(1)) = vel_r_tmp
5899# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5900 end if
5901# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5902 end if
5903 end if
5904
5905 if (wave_speeds == wave_speeds_direct) then
5906 if (elasticity) then
5907 ! Elastic wave speed, Rodriguez et al. JCP (2019)
5908 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
5909 & ))/rho_l), &
5910 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
5911 & + tau_e_r(dir_idx_tau(1)))/rho_r))
5912 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
5913 & ))/rho_r), &
5914 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
5915 & + tau_e_l(dir_idx_tau(1)))/rho_l))
5916 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
5917 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
5918 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
5919 & - vel_r(dir_idx(1))))
5920 else
5921 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5922 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5923 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5924 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
5925 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
5926 end if
5927 else if (wave_speeds == wave_speeds_pressure) then
5928 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5929
5930 pres_sr = pres_sl
5931
5932 ! Low Mach correction: Thornber et al. JCP (2008)
5933 ms_l = max(1._wp, &
5934 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
5935 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
5936 ms_r = max(1._wp, &
5937 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
5938 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
5939
5940 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5941 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5942
5943 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5944 end if
5945
5946 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5947 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5948
5949 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5950 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5951 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5952 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
5953 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5954 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5955
5956 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5957 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5958 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5959
5960 ! Low Mach correction
5961 if (low_mach == 1) then
5962 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5963# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5964 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5965# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5966 pcorr = 0._wp
5967# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5968
5969# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5970 if (low_mach == 1) then
5971# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5972 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5973# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5974 end if
5975# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5976 else if (riemann_solver == riemann_solver_hllc) then
5977# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5978 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5979# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5980 pcorr = 0._wp
5981# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5982
5983# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5984 if (low_mach == 1) then
5985# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5986 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))) &
5987# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5988 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5989# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5990 else if (low_mach == 2) then
5991# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5992 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))))
5993# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5994 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))))
5995# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5996 vel_l(dir_idx(1)) = vel_l_tmp
5997# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5998 vel_r(dir_idx(1)) = vel_r_tmp
5999# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6000 end if
6001# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6002 end if
6003 else
6004 pcorr = 0._wp
6005 end if
6006
6007 ! COMPUTING THE HLLC FLUXES MASS FLUX.
6008
6009# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6010#if defined(MFC_OpenACC)
6011# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6012!$acc loop seq
6013# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6014#elif defined(MFC_OpenMP)
6015# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6016
6017# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6018#endif
6019 do i = 1, eqn_idx%cont%end
6020 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6021 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6022 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6023 end do
6024
6025 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
6026 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
6027
6028# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6029#if defined(MFC_OpenACC)
6030# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6031!$acc loop seq
6032# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6033#elif defined(MFC_OpenMP)
6034# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6035
6036# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6037#endif
6038 do i = 1, num_dims
6039 flux_rsx_vf(j, k, l, &
6040 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
6041 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
6042 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
6043 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
6044 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
6045 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
6046 end do
6047
6048 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
6049 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
6050 flux_rsx_vf(j, k, l, &
6051 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 + xi_l*(s_s &
6052 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
6053 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
6054 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
6055 & *(s_p/s_r)*pcorr*s_s
6056
6057 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
6058 if (elasticity) then
6059 flux_ene_e = 0._wp
6060
6061# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6062#if defined(MFC_OpenACC)
6063# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6064!$acc loop seq
6065# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6066#elif defined(MFC_OpenMP)
6067# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6068
6069# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6070#endif
6071 do i = 1, num_dims
6072 ! MOMENTUM ELASTIC FLUX.
6073 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
6074 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
6075 & - xi_p*tau_e_r(dir_idx_tau(i))
6076 ! ENERGY ELASTIC FLUX.
6077 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
6078 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
6079 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
6080 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
6081 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
6082 end do
6083 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
6084 end if
6085
6086 ! HYPOELASTIC STRESS EVOLUTION FLUX.
6087 if (hypoelasticity) then
6088
6089# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6090#if defined(MFC_OpenACC)
6091# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6092!$acc loop seq
6093# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6094#elif defined(MFC_OpenMP)
6095# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6096
6097# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6098#endif
6099 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6100 flux_rsx_vf(j, k, l, &
6101 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
6102 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
6103 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
6104 end do
6105 end if
6106
6107 ! VOLUME FRACTION FLUX.
6108
6109# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6110#if defined(MFC_OpenACC)
6111# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6112!$acc loop seq
6113# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6114#elif defined(MFC_OpenMP)
6115# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6116
6117# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6118#endif
6119 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6120 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6121 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6122 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6123 end do
6124
6125 ! VOLUME FRACTION SOURCE FLUX.
6126
6127# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6128#if defined(MFC_OpenACC)
6129# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6130!$acc loop seq
6131# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6132#elif defined(MFC_OpenMP)
6133# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6134
6135# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6136#endif
6137 do i = 1, num_dims
6138 vel_src_rsx_vf(j, k, l, &
6139 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
6140 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
6141 end do
6142
6143 ! COLOR FUNCTION FLUX
6144 if (surface_tension) then
6145 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
6146 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6147 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6148 end if
6149
6150 ! Hyperelastic reference map flux for material deformation tracking
6151 if (hyperelasticity) then
6152
6153# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6154#if defined(MFC_OpenACC)
6155# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6156!$acc loop seq
6157# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6158#elif defined(MFC_OpenMP)
6159# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6160
6161# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6162#endif
6163 do i = 1, num_dims
6164 flux_rsx_vf(j, k, l, &
6165 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
6166 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
6167 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
6168 end do
6169 end if
6170
6171 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6172
6173 if (chemistry) then
6174
6175# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6176#if defined(MFC_OpenACC)
6177# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6178!$acc loop seq
6179# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6180#elif defined(MFC_OpenMP)
6181# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6182
6183# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6184#endif
6185 do i = eqn_idx%species%beg, eqn_idx%species%end
6186 y_l = ql_prim_rsx_vf(j, k, l, i)
6187 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
6188
6189 flux_rsx_vf(j, k, l, &
6190 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6191 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6192 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
6193 end do
6194 end if
6195
6196 ! Geometrical source flux for cylindrical coordinates
6197# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6198 if (cyl_coord) then
6199 ! Substituting the advective flux into the inviscid geometrical source flux
6200
6201# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6202#if defined(MFC_OpenACC)
6203# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6204!$acc loop seq
6205# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6206#elif defined(MFC_OpenMP)
6207# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6208
6209# 1585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6210#endif
6211 do i = 1, eqn_idx%E
6212 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
6213 end do
6214 ! Recalculating the radial momentum geometric source flux
6215 flux_gsrc_rsx_vf(j, k, l, &
6216 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
6217 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
6218 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
6219 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
6220 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
6221 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
6222 ! Geometrical source of the void fraction(s) is zero
6223
6224# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6225#if defined(MFC_OpenACC)
6226# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6227!$acc loop seq
6228# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6229#elif defined(MFC_OpenMP)
6230# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6231
6232# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6233#endif
6234 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6235 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6236 end do
6237 end if
6238# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6239# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6240 end do
6241 end do
6242 end do
6243
6244# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6245#if defined(MFC_OpenACC)
6246# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6247!$acc end parallel loop
6248# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6249#elif defined(MFC_OpenMP)
6250# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6251
6252# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6253!$omp end target teams loop
6254# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6255#endif
6256 end if
6257 end if
6258# 135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6259# 136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6260# 137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6261 if (norm_dir == 3) then
6262 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6263 if (model_eqns == model_eqns_6eq) then
6264 ! 6-equation model (model_eqns=3): separate phasic internal energies
6265
6266# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6267
6268# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6269#if defined(MFC_OpenACC)
6270# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6271!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP)
6272# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6273#elif defined(MFC_OpenMP)
6274# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6275
6276# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6277
6278# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6279
6280# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6281!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP)
6282# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6283#endif
6284# 151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6285 do l = is1%beg, is1%end
6286 do k = is2%beg, is2%end
6287 do j = is3%beg, is3%end
6288 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6289 rho_l = 0._wp; rho_r = 0._wp
6290 gamma_l = 0._wp; gamma_r = 0._wp
6291 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6292 qv_l = 0._wp; qv_r = 0._wp
6293 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6294
6295
6296# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6297#if defined(MFC_OpenACC)
6298# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6299!$acc loop seq
6300# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6301#elif defined(MFC_OpenMP)
6302# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6303
6304# 161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6305#endif
6306 do i = 1, num_dims
6307 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6308 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
6309 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6310 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6311 end do
6312
6313 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6314 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
6315
6316 rho_l = 0._wp
6317 gamma_l = 0._wp
6318 pi_inf_l = 0._wp
6319 qv_l = 0._wp
6320
6321 rho_r = 0._wp
6322 gamma_r = 0._wp
6323 pi_inf_r = 0._wp
6324 qv_r = 0._wp
6325
6326 alpha_l_sum = 0._wp
6327 alpha_r_sum = 0._wp
6328
6329 if (mpp_lim) then
6330
6331# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6332#if defined(MFC_OpenACC)
6333# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6334!$acc loop seq
6335# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6336#elif defined(MFC_OpenMP)
6337# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6338
6339# 186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6340#endif
6341 do i = 1, num_fluids
6342 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6343 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6344 & eqn_idx%E + i)), 1._wp)
6345 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6346 end do
6347
6348
6349# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6350#if defined(MFC_OpenACC)
6351# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6352!$acc loop seq
6353# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6354#elif defined(MFC_OpenMP)
6355# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6356
6357# 194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6358#endif
6359 do i = 1, num_fluids
6360 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
6361 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
6362 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
6363 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6364 end do
6365
6366
6367# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6368#if defined(MFC_OpenACC)
6369# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6370!$acc loop seq
6371# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6372#elif defined(MFC_OpenMP)
6373# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6374
6375# 202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6376#endif
6377 do i = 1, num_fluids
6378 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6379 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6380 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
6381 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6382 end do
6383 end if
6384
6385
6386# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6387#if defined(MFC_OpenACC)
6388# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6389!$acc loop seq
6390# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6391#elif defined(MFC_OpenMP)
6392# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6393
6394# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6395#endif
6396 do i = 1, num_fluids
6397 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
6398 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
6399 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
6400 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
6401
6402 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
6403 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
6404 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
6405 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
6406
6407 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6408 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
6409 end do
6410
6411 if (viscous) then
6412
6413# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6414#if defined(MFC_OpenACC)
6415# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6416!$acc loop seq
6417# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6418#elif defined(MFC_OpenMP)
6419# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6420
6421# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6422#endif
6423 do i = 1, 2
6424 re_l(i) = dflt_real
6425 re_r(i) = dflt_real
6426 if (re_size(i) > 0) re_l(i) = 0._wp
6427 if (re_size(i) > 0) re_r(i) = 0._wp
6428
6429# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6430#if defined(MFC_OpenACC)
6431# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6432!$acc loop seq
6433# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6434#elif defined(MFC_OpenMP)
6435# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6436
6437# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6438#endif
6439 do q = 1, re_size(i)
6440 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
6441 re_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, q))/res_gs(i, &
6442 & q) + re_r(i)
6443 end do
6444 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6445 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6446 end do
6447 end if
6448
6449 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6450 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6451
6452 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6453 if (hypoelasticity) then
6454
6455# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6456#if defined(MFC_OpenACC)
6457# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6458!$acc loop seq
6459# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6460#elif defined(MFC_OpenMP)
6461# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6462
6463# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6464#endif
6465 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6466 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6467 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
6468 end do
6469 g_l = 0._wp; g_r = 0._wp
6470
6471# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6472#if defined(MFC_OpenACC)
6473# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6474!$acc loop seq
6475# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6476#elif defined(MFC_OpenMP)
6477# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6478
6479# 256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6480#endif
6481 do i = 1, num_fluids
6482 g_l = g_l + alpha_l(i)*gs_rs(i)
6483 g_r = g_r + alpha_r(i)*gs_rs(i)
6484 end do
6485
6486# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6487#if defined(MFC_OpenACC)
6488# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6489!$acc loop seq
6490# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6491#elif defined(MFC_OpenMP)
6492# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6493
6494# 261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6495#endif
6496 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6497 ! Elastic contribution to energy if G large enough
6498 if ((g_l > verysmall) .and. (g_r > verysmall)) then
6499 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6500 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6501 ! Additional terms in 2D and 3D
6502 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
6503 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6504 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6505 end if
6506 end if
6507 end do
6508 end if
6509
6510 ! Hyperelastic stress contribution: strain energy added to total energy
6511 if (hyperelasticity) then
6512
6513# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6514#if defined(MFC_OpenACC)
6515# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6516!$acc loop seq
6517# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6518#elif defined(MFC_OpenMP)
6519# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6520
6521# 278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6522#endif
6523 do i = 1, num_dims
6524 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
6525 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
6526 end do
6527 g_l = 0._wp; g_r = 0._wp
6528
6529# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6530#if defined(MFC_OpenACC)
6531# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6532!$acc loop seq
6533# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6534#elif defined(MFC_OpenMP)
6535# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6536
6537# 284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6538#endif
6539 do i = 1, num_fluids
6540 ! Mixture left and right shear modulus
6541 g_l = g_l + alpha_l(i)*gs_rs(i)
6542 g_r = g_r + alpha_r(i)*gs_rs(i)
6543 end do
6544 ! Elastic contribution to energy if G large enough
6545 if (g_l > verysmall .and. g_r > verysmall) then
6546 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
6547 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
6548 end if
6549
6550# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6551#if defined(MFC_OpenACC)
6552# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6553!$acc loop seq
6554# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6555#elif defined(MFC_OpenMP)
6556# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6557
6558# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6559#endif
6560 do i = 1, b_size - 1
6561 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6562 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
6563 end do
6564 end if
6565
6566 h_l = (e_l + pres_l)/rho_l
6567 h_r = (e_r + pres_r)/rho_r
6568
6569 if (avg_state == avg_state_roe) then
6570# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6571 rho_avg = sqrt(rho_l*rho_r)
6572# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6573
6574# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6575 vel_avg_rms = 0._wp
6576# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6577
6578# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6579
6580# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6581#if defined(MFC_OpenACC)
6582# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6583!$acc loop seq
6584# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6585#elif defined(MFC_OpenMP)
6586# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6587
6588# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6589#endif
6590# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6591 do i = 1, num_vels
6592# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6593 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
6594# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6595 end do
6596# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6597
6598# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6599 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6600# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6601
6602# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6603 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6604# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6605
6606# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6607 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
6608# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6609
6610# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6611 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6612# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6613
6614# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6615 if (chemistry) then
6616# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6617 eps = 0.001_wp
6618# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6619 call get_species_enthalpies_rt(t_l, h_il)
6620# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6621 call get_species_enthalpies_rt(t_r, h_ir)
6622# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6623 h_il = h_il*gas_constant/molecular_weights*t_l
6624# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6625 h_ir = h_ir*gas_constant/molecular_weights*t_r
6626# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6627 call get_species_specific_heats_r(t_l, cp_il)
6628# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6629 call get_species_specific_heats_r(t_r, cp_ir)
6630# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6631
6632# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6633 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6634# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6635 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6636# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6637 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6638# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6639 if (abs(t_l - t_r) < eps) then
6640# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6641 ! Case when T_L and T_R are very close
6642# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6643 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6644# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6645 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6646# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6647 & - gas_constant/molecular_weights(:)))
6648# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6649 else
6650# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6651 ! Normal calculation when T_L and T_R are sufficiently different
6652# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6653 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6654# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6655 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6656# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6657 end if
6658# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6659 gamma_avg = cp_avg/cv_avg
6660# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6661
6662# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6663 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6664# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6665 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6666# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6667 end if
6668# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6669 end if
6670# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6671
6672# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6673 if (avg_state == avg_state_arithmetic) then
6674# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6675 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6676# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6677 vel_avg_rms = 0._wp
6678# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6679
6680# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6681#if defined(MFC_OpenACC)
6682# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6683!$acc loop seq
6684# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6685#elif defined(MFC_OpenMP)
6686# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6687
6688# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6689#endif
6690# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6691 do i = 1, num_vels
6692# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6693 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6694# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6695 end do
6696# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6697
6698# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6699 h_avg = 5.e-1_wp*(h_l + h_r)
6700# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6701 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6702# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6703 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6704# 305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6705 end if
6706
6707 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6708 & c_l, qv_l)
6709
6710 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6711 & c_r, qv_r)
6712
6713 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6714 ! variables are placeholders to call the subroutine.
6715 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6716 & 0._wp, c_avg, qv_avg)
6717
6718 if (viscous) then
6719
6720# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6721#if defined(MFC_OpenACC)
6722# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6723!$acc loop seq
6724# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6725#elif defined(MFC_OpenMP)
6726# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6727
6728# 319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6729#endif
6730 do i = 1, 2
6731 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6732 end do
6733 end if
6734
6735 ! Low Mach correction
6736 if (low_mach == 2) then
6737 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6738# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6739 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6740# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6741 pcorr = 0._wp
6742# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6743
6744# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6745 if (low_mach == 1) then
6746# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6747 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6748# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6749 end if
6750# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6751 else if (riemann_solver == riemann_solver_hllc) then
6752# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6753 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6754# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6755 pcorr = 0._wp
6756# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6757
6758# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6759 if (low_mach == 1) then
6760# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6761 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))) &
6762# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6763 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6764# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6765 else if (low_mach == 2) then
6766# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6767 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))))
6768# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6769 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))))
6770# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6771 vel_l(dir_idx(1)) = vel_l_tmp
6772# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6773 vel_r(dir_idx(1)) = vel_r_tmp
6774# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6775 end if
6776# 327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6777 end if
6778 end if
6779
6780 ! COMPUTING THE DIRECT WAVE SPEEDS
6781 if (wave_speeds == wave_speeds_direct) then
6782 if (elasticity) then
6783 ! Elastic wave speed, Rodriguez et al. JCP (2019)
6784 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
6785 & ))/rho_l), &
6786 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
6787 & + tau_e_r(dir_idx_tau(1)))/rho_r))
6788 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
6789 & ))/rho_r), &
6790 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
6791 & + tau_e_l(dir_idx_tau(1)))/rho_l))
6792 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
6793 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
6794 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
6795 & - vel_r(dir_idx(1))))
6796 else
6797 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6798 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6799 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6800 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
6801 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
6802 end if
6803 else if (wave_speeds == wave_speeds_pressure) then
6804 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6805
6806 pres_sr = pres_sl
6807
6808 ! Low Mach correction: Thornber et al. JCP (2008)
6809 ms_l = max(1._wp, &
6810 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
6811 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
6812 ms_r = max(1._wp, &
6813 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
6814 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
6815
6816 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6817 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6818
6819 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6820 end if
6821
6822 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6823 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6824
6825 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6826 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6827 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6828 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6829 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6830
6831 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6832 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
6833 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
6834
6835 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
6836 xi_mp = -min(0._wp, sign(1._wp, s_l))
6837 xi_pp = max(0._wp, sign(1._wp, s_r))
6838
6839 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 &
6840 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
6841 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
6842 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
6843 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
6844
6845 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))
6846
6847 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 &
6848 & - vel_r(dir_idx(1)))
6849
6850 ! Low Mach correction
6851 if (low_mach == 1) then
6852 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6853# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6854 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6855# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6856 pcorr = 0._wp
6857# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6858
6859# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6860 if (low_mach == 1) then
6861# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6862 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6863# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6864 end if
6865# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6866 else if (riemann_solver == riemann_solver_hllc) then
6867# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6868 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6869# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6870 pcorr = 0._wp
6871# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6872
6873# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6874 if (low_mach == 1) then
6875# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6876 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))) &
6877# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6878 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6879# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6880 else if (low_mach == 2) then
6881# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6882 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))))
6883# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6884 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))))
6885# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6886 vel_l(dir_idx(1)) = vel_l_tmp
6887# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6888 vel_r(dir_idx(1)) = vel_r_tmp
6889# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6890 end if
6891# 402 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6892 end if
6893 else
6894 pcorr = 0._wp
6895 end if
6896
6897 ! COMPUTING FLUXES MASS FLUX.
6898
6899# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6900#if defined(MFC_OpenACC)
6901# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6902!$acc loop seq
6903# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6904#elif defined(MFC_OpenMP)
6905# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6906
6907# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6908#endif
6909 do i = 1, eqn_idx%cont%end
6910 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6911 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6912 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6913 end do
6914
6915 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6916
6917# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6918#if defined(MFC_OpenACC)
6919# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6920!$acc loop seq
6921# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6922#elif defined(MFC_OpenMP)
6923# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6924
6925# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6926#endif
6927 do i = 1, num_dims
6928 flux_rsx_vf(j, k, l, &
6929 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
6930 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
6931 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
6932 & *dir_flg(dir_idx(i))*pcorr
6933 end do
6934
6935 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
6936 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
6937
6938 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
6939 if (elasticity) then
6940 flux_ene_e = 0._wp
6941
6942# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6943#if defined(MFC_OpenACC)
6944# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6945!$acc loop seq
6946# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6947#elif defined(MFC_OpenMP)
6948# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6949
6950# 431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6951#endif
6952 do i = 1, num_dims
6953 ! MOMENTUM ELASTIC FLUX.
6954 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
6955 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
6956 & - xi_p*tau_e_r(dir_idx_tau(i))
6957 ! ENERGY ELASTIC FLUX.
6958 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
6959 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
6960 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
6961 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
6962 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
6963 end do
6964 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
6965 end if
6966
6967 ! VOLUME FRACTION FLUX.
6968
6969# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6970#if defined(MFC_OpenACC)
6971# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6972!$acc loop seq
6973# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6974#elif defined(MFC_OpenMP)
6975# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6976
6977# 448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6978#endif
6979 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6980 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6981 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
6982 end do
6983
6984 ! Advection velocity source: interface velocity for volume fraction transport
6985
6986# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6987#if defined(MFC_OpenACC)
6988# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6989!$acc loop seq
6990# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6991#elif defined(MFC_OpenMP)
6992# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6993
6994# 455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6995#endif
6996 do i = 1, num_dims
6997 vel_src_rsx_vf(j, k, l, &
6998 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
6999 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
7000 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
7001 end do
7002
7003 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7004 ! energy flux
7005
7006# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7007#if defined(MFC_OpenACC)
7008# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7009!$acc loop seq
7010# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7011#elif defined(MFC_OpenMP)
7012# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7013
7014# 465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7015#endif
7016 do i = 1, num_fluids
7017 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7018 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7019 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7020 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7021 & + pres_r)
7022
7023 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7024 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7025 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7026 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7027 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7028 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7029 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7030 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7031 & i + eqn_idx%adv%beg - 1))
7032 end do
7033
7034 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7035
7036 ! HYPOELASTIC STRESS EVOLUTION FLUX.
7037 if (hypoelasticity) then
7038
7039# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7040#if defined(MFC_OpenACC)
7041# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7042!$acc loop seq
7043# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7044#elif defined(MFC_OpenMP)
7045# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7046
7047# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7048#endif
7049 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7050 flux_rsx_vf(j, k, l, &
7051 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
7052 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7053 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
7054 end do
7055 end if
7056
7057 ! Hyperelastic reference map flux for material deformation tracking
7058 if (hyperelasticity) then
7059
7060# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7061#if defined(MFC_OpenACC)
7062# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7063!$acc loop seq
7064# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7065#elif defined(MFC_OpenMP)
7066# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7067
7068# 499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7069#endif
7070 do i = 1, num_dims
7071 flux_rsx_vf(j, k, l, &
7072 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
7073 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7074 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
7075 end do
7076 end if
7077
7078 ! COLOR FUNCTION FLUX
7079 if (surface_tension) then
7080 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7081 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
7082 end if
7083
7084 ! Geometrical source flux for cylindrical coordinates
7085# 537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7086# 538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7087 if (grid_geometry == 3) then
7088
7089# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7090#if defined(MFC_OpenACC)
7091# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7092!$acc loop seq
7093# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7094#elif defined(MFC_OpenMP)
7095# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7096
7097# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7098#endif
7099 do i = 1, sys_size
7100 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7101 end do
7102 flux_gsrc_rsx_vf(j, k, l, &
7103 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
7104 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
7105
7106 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7107 end if
7108# 550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7109 end do
7110 end do
7111 end do
7112
7113# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7114#if defined(MFC_OpenACC)
7115# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7116!$acc end parallel loop
7117# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7118#elif defined(MFC_OpenMP)
7119# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7120
7121# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7122!$omp end target teams loop
7123# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7124#endif
7125 else if (model_eqns == model_eqns_4eq) then
7126 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
7127
7128# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7129
7130# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7131#if defined(MFC_OpenACC)
7132# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7133!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, 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)
7134# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7135#elif defined(MFC_OpenMP)
7136# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7137
7138# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7139
7140# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7141
7142# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7143!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, 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)
7144# 556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7145#endif
7146# 565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7147 do l = is1%beg, is1%end
7148 do k = is2%beg, is2%end
7149 do j = is3%beg, is3%end
7150 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7151 rho_l = 0._wp; rho_r = 0._wp
7152 gamma_l = 0._wp; gamma_r = 0._wp
7153 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7154 qv_l = 0._wp; qv_r = 0._wp
7155
7156
7157# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7158#if defined(MFC_OpenACC)
7159# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7160!$acc loop seq
7161# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7162#elif defined(MFC_OpenMP)
7163# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7164
7165# 574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7166#endif
7167 do i = 1, eqn_idx%cont%end
7168 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7169 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7170 end do
7171
7172
7173# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7174#if defined(MFC_OpenACC)
7175# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7176!$acc loop seq
7177# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7178#elif defined(MFC_OpenMP)
7179# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7180
7181# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7182#endif
7183 do i = 1, num_dims
7184 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7185 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7186 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7187 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7188 end do
7189
7190
7191# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7192#if defined(MFC_OpenACC)
7193# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7194!$acc loop seq
7195# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7196#elif defined(MFC_OpenMP)
7197# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7198
7199# 588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7200#endif
7201 do i = 1, num_fluids
7202 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7203 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7204 end do
7205
7206# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7207#if defined(MFC_OpenACC)
7208# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7209!$acc loop seq
7210# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7211#elif defined(MFC_OpenMP)
7212# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7213
7214# 593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7215#endif
7216 do i = 1, num_fluids
7217 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7218 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7219 end do
7220
7221
7222# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7223#if defined(MFC_OpenACC)
7224# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7225!$acc loop seq
7226# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7227#elif defined(MFC_OpenMP)
7228# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7229
7230# 599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7231#endif
7232 do i = 1, num_fluids
7233 rho_l = rho_l + alpha_rho_l(i)
7234 gamma_l = gamma_l + alpha_l(i)*gammas(i)
7235 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
7236 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
7237
7238 rho_r = rho_r + alpha_rho_r(i)
7239 gamma_r = gamma_r + alpha_r(i)*gammas(i)
7240 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
7241 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
7242 end do
7243
7244 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7245 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7246
7247 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7248 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7249
7250 h_l = (e_l + pres_l)/rho_l
7251 h_r = (e_r + pres_r)/rho_r
7252
7253 if (avg_state == avg_state_roe) then
7254# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7255 rho_avg = sqrt(rho_l*rho_r)
7256# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7257
7258# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7259 vel_avg_rms = 0._wp
7260# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7261
7262# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7263
7264# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7265#if defined(MFC_OpenACC)
7266# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7267!$acc loop seq
7268# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7269#elif defined(MFC_OpenMP)
7270# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7271
7272# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7273#endif
7274# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7275 do i = 1, num_vels
7276# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7277 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
7278# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7279 end do
7280# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7281
7282# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7283 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7284# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7285
7286# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7287 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7288# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7289
7290# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7291 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
7292# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7293
7294# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7295 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7296# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7297
7298# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7299 if (chemistry) then
7300# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7301 eps = 0.001_wp
7302# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7303 call get_species_enthalpies_rt(t_l, h_il)
7304# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7305 call get_species_enthalpies_rt(t_r, h_ir)
7306# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7307 h_il = h_il*gas_constant/molecular_weights*t_l
7308# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7309 h_ir = h_ir*gas_constant/molecular_weights*t_r
7310# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7311 call get_species_specific_heats_r(t_l, cp_il)
7312# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7313 call get_species_specific_heats_r(t_r, cp_ir)
7314# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7315
7316# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7317 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7318# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7319 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7320# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7321 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7322# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7323 if (abs(t_l - t_r) < eps) then
7324# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7325 ! Case when T_L and T_R are very close
7326# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7327 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7328# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7329 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7330# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7331 & - gas_constant/molecular_weights(:)))
7332# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7333 else
7334# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7335 ! Normal calculation when T_L and T_R are sufficiently different
7336# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7337 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7338# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7339 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7340# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7341 end if
7342# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7343 gamma_avg = cp_avg/cv_avg
7344# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7345
7346# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7347 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7348# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7349 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7350# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7351 end if
7352# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7353 end if
7354# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7355
7356# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7357 if (avg_state == avg_state_arithmetic) then
7358# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7359 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7360# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7361 vel_avg_rms = 0._wp
7362# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7363
7364# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7365#if defined(MFC_OpenACC)
7366# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7367!$acc loop seq
7368# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7369#elif defined(MFC_OpenMP)
7370# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7371
7372# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7373#endif
7374# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7375 do i = 1, num_vels
7376# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7377 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7378# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7379 end do
7380# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7381
7382# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7383 h_avg = 5.e-1_wp*(h_l + h_r)
7384# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7385 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7386# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7387 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7388# 621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7389 end if
7390
7391 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7392 & c_l, qv_l)
7393
7394 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7395 & c_r, qv_r)
7396
7397 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7398 ! variables are placeholders to call the subroutine.
7399
7400 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7401 & 0._wp, c_avg, qv_avg)
7402
7403 if (wave_speeds == wave_speeds_direct) then
7404 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7405 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7406
7407 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7408 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7409 & - rho_r*(s_r - vel_r(dir_idx(1))))
7410 else if (wave_speeds == wave_speeds_pressure) then
7411 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7412
7413 pres_sr = pres_sl
7414
7415 ! Low Mach correction: Thornber et al. JCP (2008)
7416 ms_l = max(1._wp, &
7417 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7418 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7419 ms_r = max(1._wp, &
7420 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7421 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7422
7423 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7424 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7425
7426 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7427 end if
7428
7429 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7430 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7431
7432 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7433 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7434 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7435 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7436 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7437
7438 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7439 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7440 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7441
7442
7443# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7444#if defined(MFC_OpenACC)
7445# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7446!$acc loop seq
7447# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7448#elif defined(MFC_OpenMP)
7449# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7450
7451# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7452#endif
7453 do i = 1, eqn_idx%cont%end
7454 flux_rsx_vf(j, k, l, &
7455 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
7456 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7457 end do
7458
7459 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7460
7461# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7462#if defined(MFC_OpenACC)
7463# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7464!$acc loop seq
7465# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7466#elif defined(MFC_OpenMP)
7467# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7468
7469# 682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7470#endif
7471 do i = 1, num_dims
7472 flux_rsx_vf(j, k, l, &
7473 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
7474 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7475 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
7476 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7477 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7478 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
7479 end do
7480
7481 if (bubbles_euler) then
7482 ! Put p_tilde in
7483
7484# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7485#if defined(MFC_OpenACC)
7486# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7487!$acc loop seq
7488# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7489#elif defined(MFC_OpenMP)
7490# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7491
7492# 695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7493#endif
7494 do i = 1, num_dims
7495 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7496 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
7497 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
7498 end do
7499 end if
7500
7501 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
7502
7503
7504# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7505#if defined(MFC_OpenACC)
7506# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7507!$acc loop seq
7508# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7509#elif defined(MFC_OpenMP)
7510# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7511
7512# 705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7513#endif
7514 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
7515 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7516 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7517 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7518 end do
7519
7520 ! Advection velocity source: interface velocity for volume fraction transport
7521
7522# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7523#if defined(MFC_OpenACC)
7524# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7525!$acc loop seq
7526# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7527#elif defined(MFC_OpenMP)
7528# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7529
7530# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7531#endif
7532 do i = 1, num_dims
7533 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
7534 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7535 end do
7536
7537 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7538
7539 ! Add advection flux for bubble variables
7540 if (bubbles_euler) then
7541
7542# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7543#if defined(MFC_OpenACC)
7544# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7545!$acc loop seq
7546# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7547#elif defined(MFC_OpenMP)
7548# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7549
7550# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7551#endif
7552 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7553 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7554 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7555 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, &
7556 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7557 end do
7558 end if
7559
7560 ! Geometrical source flux for cylindrical coordinates
7561
7562# 756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7563# 757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7564 if (grid_geometry == 3) then
7565
7566# 758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7567#if defined(MFC_OpenACC)
7568# 758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7569!$acc loop seq
7570# 758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7571#elif defined(MFC_OpenMP)
7572# 758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7573
7574# 758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7575#endif
7576 do i = 1, sys_size
7577 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7578 end do
7579 flux_gsrc_rsx_vf(j, k, l, &
7580 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
7581 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
7582 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
7583 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
7584 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
7585 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
7586 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7587 end if
7588# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7589 end do
7590 end do
7591 end do
7592
7593# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7594#if defined(MFC_OpenACC)
7595# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7596!$acc end parallel loop
7597# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7598#elif defined(MFC_OpenMP)
7599# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7600
7601# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7602!$omp end target teams loop
7603# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7604#endif
7605 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
7606 ! 5-equation model with Euler-Euler bubble dynamics
7607
7608# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7609
7610# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7611#if defined(MFC_OpenACC)
7612# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7613!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
7614# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7615#elif defined(MFC_OpenMP)
7616# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7617
7618# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7619
7620# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7621
7622# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7623!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_L_m1, xi_R_m1, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
7624# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7625#endif
7626# 786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7627 do l = is1%beg, is1%end
7628 do k = is2%beg, is2%end
7629 do j = is3%beg, is3%end
7630 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7631 rho_l = 0._wp; rho_r = 0._wp
7632 gamma_l = 0._wp; gamma_r = 0._wp
7633 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7634 qv_l = 0._wp; qv_r = 0._wp
7635
7636
7637# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7638#if defined(MFC_OpenACC)
7639# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7640!$acc loop seq
7641# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7642#elif defined(MFC_OpenMP)
7643# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7644
7645# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7646#endif
7647 do i = 1, num_fluids
7648 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7649 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7650 end do
7651
7652 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7653
7654
7655# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7656#if defined(MFC_OpenACC)
7657# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7658!$acc loop seq
7659# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7660#elif defined(MFC_OpenMP)
7661# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7662
7663# 803 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7664#endif
7665 do i = 1, num_dims
7666 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7667 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7668 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7669 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7670 end do
7671
7672 ! Retain this in the refactor
7673 if (mpp_lim .and. (num_fluids > 2)) then
7674
7675# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7676#if defined(MFC_OpenACC)
7677# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7678!$acc loop seq
7679# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7680#elif defined(MFC_OpenMP)
7681# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7682
7683# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7684#endif
7685 do i = 1, num_fluids
7686 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7687 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7688 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7689 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7690 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
7691 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
7692 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
7693 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
7694 end do
7695 else if (num_fluids > 2) then
7696
7697# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7698#if defined(MFC_OpenACC)
7699# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7700!$acc loop seq
7701# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7702#elif defined(MFC_OpenMP)
7703# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7704
7705# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7706#endif
7707 do i = 1, num_fluids - 1
7708 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7709 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7710 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7711 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7712 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
7713 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
7714 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
7715 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
7716 end do
7717 else
7718 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7719 gamma_l = gammas(1)
7720 pi_inf_l = pi_infs(1)
7721 qv_l = qvs(1)
7722 rho_r = qr_prim_rsx_vf(j, k, l + 1, 1)
7723 gamma_r = gammas(1)
7724 pi_inf_r = pi_infs(1)
7725 qv_r = qvs(1)
7726 end if
7727
7728 if (viscous) then
7729 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7730
7731# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7732#if defined(MFC_OpenACC)
7733# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7734!$acc loop seq
7735# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7736#elif defined(MFC_OpenMP)
7737# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7738
7739# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7740#endif
7741 do i = 1, 2
7742 re_l(i) = dflt_real
7743 re_r(i) = dflt_real
7744
7745 if (re_size(i) > 0) re_l(i) = 0._wp
7746 if (re_size(i) > 0) re_r(i) = 0._wp
7747
7748
7749# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7750#if defined(MFC_OpenACC)
7751# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7752!$acc loop seq
7753# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7754#elif defined(MFC_OpenMP)
7755# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7756
7757# 857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7758#endif
7759 do q = 1, re_size(i)
7760 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7761 & q)))/res_gs(i, q) + re_l(i)
7762 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
7763 & q)))/res_gs(i, q) + re_r(i)
7764 end do
7765
7766 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7767 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7768 end do
7769 end if
7770 end if
7771
7772 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7773 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7774
7775 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7776 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7777
7778 h_l = (e_l + pres_l)/rho_l
7779 h_r = (e_r + pres_r)/rho_r
7780
7781 if (avg_state == avg_state_arithmetic) then
7782
7783# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7784#if defined(MFC_OpenACC)
7785# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7786!$acc loop seq
7787# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7788#elif defined(MFC_OpenMP)
7789# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7790
7791# 881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7792#endif
7793 do i = 1, nb
7794 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7795 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
7796
7797 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
7798 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
7799 if (.not. polytropic .and. .not. qbmm) then
7800 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
7801 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
7802 end if
7803 end do
7804
7805 if (.not. qbmm) then
7806 if (adv_n) then
7807 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
7808 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
7809 else
7810 nbub_l = 0._wp
7811 nbub_r = 0._wp
7812
7813# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7814#if defined(MFC_OpenACC)
7815# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7816!$acc loop seq
7817# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7818#elif defined(MFC_OpenMP)
7819# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7820
7821# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7822#endif
7823 do i = 1, nb
7824 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
7825 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
7826 end do
7827
7828 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
7829 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
7830 & eqn_idx%E + num_fluids)/nbub_r
7831 end if
7832 else
7833 ! nb stored in 0th moment of first R0 bin in variable conversion module
7834 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
7835 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
7836 end if
7837
7838
7839# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7840#if defined(MFC_OpenACC)
7841# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7842!$acc loop seq
7843# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7844#elif defined(MFC_OpenMP)
7845# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7846
7847# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7848#endif
7849 do i = 1, nb
7850 if (.not. qbmm) then
7851 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
7852 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
7853 end if
7854 end do
7855
7856 if (qbmm) then
7857 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
7858 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
7859
7860 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
7861 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
7862
7863 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
7864 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
7865 else
7866 pbwr3lbar = 0._wp
7867 pbwr3rbar = 0._wp
7868
7869 r3lbar = 0._wp
7870 r3rbar = 0._wp
7871
7872 r3v2lbar = 0._wp
7873 r3v2rbar = 0._wp
7874
7875
7876# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7877#if defined(MFC_OpenACC)
7878# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7879!$acc loop seq
7880# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7881#elif defined(MFC_OpenMP)
7882# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7883
7884# 944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7885#endif
7886 do i = 1, nb
7887 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
7888 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
7889
7890 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
7891 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
7892
7893 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
7894 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
7895 end do
7896 end if
7897
7898 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7899 h_avg = 5.e-1_wp*(h_l + h_r)
7900 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7901 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7902 vel_avg_rms = 0._wp
7903
7904
7905# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7906#if defined(MFC_OpenACC)
7907# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7908!$acc loop seq
7909# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7910#elif defined(MFC_OpenMP)
7911# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7912
7913# 963 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7914#endif
7915 do i = 1, num_dims
7916 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7917 end do
7918 end if
7919
7920 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7921 & c_l, qv_l)
7922
7923 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7924 & c_r, qv_r)
7925
7926 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7927 ! variables are placeholders to call the subroutine.
7928 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7929 & 0._wp, c_avg, qv_avg)
7930
7931 if (viscous) then
7932
7933# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7934#if defined(MFC_OpenACC)
7935# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7936!$acc loop seq
7937# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7938#elif defined(MFC_OpenMP)
7939# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7940
7941# 981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7942#endif
7943 do i = 1, 2
7944 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7945 end do
7946 end if
7947
7948 ! Low Mach correction
7949 if (low_mach == 2) then
7950 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7951# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7952 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7953# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7954 pcorr = 0._wp
7955# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7956
7957# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7958 if (low_mach == 1) then
7959# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7960 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7961# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7962 end if
7963# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7964 else if (riemann_solver == riemann_solver_hllc) then
7965# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7966 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7967# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7968 pcorr = 0._wp
7969# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7970
7971# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7972 if (low_mach == 1) then
7973# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7974 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))) &
7975# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7976 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7977# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7978 else if (low_mach == 2) then
7979# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7980 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))))
7981# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7982 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))))
7983# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7984 vel_l(dir_idx(1)) = vel_l_tmp
7985# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7986 vel_r(dir_idx(1)) = vel_r_tmp
7987# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7988 end if
7989# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7990 end if
7991 end if
7992
7993 if (wave_speeds == wave_speeds_direct) then
7994 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7995 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7996
7997 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7998 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7999 & - rho_r*(s_r - vel_r(dir_idx(1))))
8000 else if (wave_speeds == wave_speeds_pressure) then
8001 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8002
8003 pres_sr = pres_sl
8004
8005 ! Low Mach correction: Thornber et al. JCP (2008)
8006 ms_l = max(1._wp, &
8007 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8008 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8009 ms_r = max(1._wp, &
8010 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8011 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8012
8013 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8014 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8015
8016 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8017 end if
8018
8019 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8020 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8021
8022 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8023 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8024 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8025 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8026 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8027
8028 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8029 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8030 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8031
8032 ! Low Mach correction
8033 if (low_mach == 1) then
8034 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8035# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8036 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8037# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8038 pcorr = 0._wp
8039# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8040
8041# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8042 if (low_mach == 1) then
8043# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8044 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8045# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8046 end if
8047# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8048 else if (riemann_solver == riemann_solver_hllc) then
8049# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8050 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8051# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8052 pcorr = 0._wp
8053# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8054
8055# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8056 if (low_mach == 1) then
8057# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8058 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))) &
8059# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8060 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8061# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8062 else if (low_mach == 2) then
8063# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8064 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))))
8065# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8066 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))))
8067# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8068 vel_l(dir_idx(1)) = vel_l_tmp
8069# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8070 vel_r(dir_idx(1)) = vel_r_tmp
8071# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8072 end if
8073# 1033 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8074 end if
8075 else
8076 pcorr = 0._wp
8077 end if
8078
8079
8080# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8081#if defined(MFC_OpenACC)
8082# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8083!$acc loop seq
8084# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8085#elif defined(MFC_OpenMP)
8086# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8087
8088# 1038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8089#endif
8090 do i = 1, eqn_idx%cont%end
8091 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8092 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8093 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8094 end do
8095
8096 if (bubbles_euler .and. (num_fluids > 1)) then
8097 ! Kill mass transport @ gas density
8098 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
8099 end if
8100
8101 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8102
8103 ! Include p_tilde
8104
8105 if (avg_state == avg_state_arithmetic) then
8106 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
8107 pres_l = pres_l - alpha_l(num_fluids)*pres_l
8108 else
8109 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
8110 end if
8111
8112 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
8113 pres_r = pres_r - alpha_r(num_fluids)*pres_r
8114 else
8115 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
8116 end if
8117 end if
8118
8119
8120# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8121#if defined(MFC_OpenACC)
8122# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8123!$acc loop seq
8124# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8125#elif defined(MFC_OpenMP)
8126# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8127
8128# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8129#endif
8130 do i = 1, num_dims
8131 flux_rsx_vf(j, k, l, &
8132 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
8133 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8134 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
8135 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
8136 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8137 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
8138 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8139 end do
8140
8141 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
8142 flux_rsx_vf(j, k, l, &
8143 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
8144 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
8145 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
8146 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
8147 & *pcorr*s_s
8148
8149 ! Volume fraction flux
8150
8151# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8152#if defined(MFC_OpenACC)
8153# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8154!$acc loop seq
8155# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8156#elif defined(MFC_OpenMP)
8157# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8158
8159# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8160#endif
8161 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8162 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8163 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8164 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8165 end do
8166
8167 ! Advection velocity source: interface velocity for volume fraction transport
8168
8169# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8170#if defined(MFC_OpenACC)
8171# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8172!$acc loop seq
8173# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8174#elif defined(MFC_OpenMP)
8175# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8176
8177# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8178#endif
8179 do i = 1, num_dims
8180 vel_src_rsx_vf(j, k, l, &
8181 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8182 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8183
8184 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8185 end do
8186
8187 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8188
8189 ! Add advection flux for bubble variables
8190
8191# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8192#if defined(MFC_OpenACC)
8193# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8194!$acc loop seq
8195# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8196#elif defined(MFC_OpenMP)
8197# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8198
8199# 1109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8200#endif
8201 do i = eqn_idx%bub%beg, eqn_idx%bub%end
8202 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
8203 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8204 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8205 end do
8206
8207 if (qbmm) then
8208 flux_rsx_vf(j, k, l, &
8209 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8210 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8211 end if
8212
8213 if (adv_n) then
8214 flux_rsx_vf(j, k, l, &
8215 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8216 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8217 end if
8218
8219 ! Geometrical source flux for cylindrical coordinates
8220# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8221# 1152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8222 if (grid_geometry == 3) then
8223
8224# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8225#if defined(MFC_OpenACC)
8226# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8227!$acc loop seq
8228# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8229#elif defined(MFC_OpenMP)
8230# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8231
8232# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8233#endif
8234 do i = 1, sys_size
8235 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
8236 end do
8237
8238 flux_gsrc_rsx_vf(j, k, l, &
8239 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
8240 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
8241 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
8242 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
8243 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
8244 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
8245 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
8246 end if
8247# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8248 end do
8249 end do
8250 end do
8251
8252# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8253#if defined(MFC_OpenACC)
8254# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8255!$acc end parallel loop
8256# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8257#elif defined(MFC_OpenMP)
8258# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8259
8260# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8261!$omp end target teams loop
8262# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8263#endif
8264 else
8265 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
8266
8267# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8268
8269# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8270#if defined(MFC_OpenACC)
8271# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8272!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, 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, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
8273# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8274#elif defined(MFC_OpenMP)
8275# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8276
8277# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8278
8279# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8280
8281# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8282!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, 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, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
8283# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8284#endif
8285# 1183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8286 do l = is1%beg, is1%end
8287 do k = is2%beg, is2%end
8288 do j = is3%beg, is3%end
8289 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8290 rho_l = 0._wp; rho_r = 0._wp
8291 gamma_l = 0._wp; gamma_r = 0._wp
8292 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8293 qv_l = 0._wp; qv_r = 0._wp
8294 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8295
8296
8297# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8298#if defined(MFC_OpenACC)
8299# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8300!$acc loop seq
8301# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8302#elif defined(MFC_OpenMP)
8303# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8304
8305# 1193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8306#endif
8307 do i = 1, num_fluids
8308 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8309 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8310 end do
8311
8312
8313# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8314#if defined(MFC_OpenACC)
8315# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8316!$acc loop seq
8317# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8318#elif defined(MFC_OpenMP)
8319# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8320
8321# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8322#endif
8323 do i = 1, num_dims
8324 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8325 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
8326 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8327 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8328 end do
8329
8330 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8331 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
8332
8333 ! Change this by splitting it into the cases present in the bubbles_euler
8334 if (mpp_lim) then
8335
8336# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8337#if defined(MFC_OpenACC)
8338# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8339!$acc loop seq
8340# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8341#elif defined(MFC_OpenMP)
8342# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8343
8344# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8345#endif
8346 do i = 1, num_fluids
8347 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8348 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8349 & eqn_idx%E + i)), 1._wp)
8350 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
8351 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
8352 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
8353 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8354 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8355 end do
8356
8357
8358# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8359#if defined(MFC_OpenACC)
8360# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8361!$acc loop seq
8362# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8363#elif defined(MFC_OpenMP)
8364# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8365
8366# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8367#endif
8368 do i = 1, num_fluids
8369 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8370 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8371 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
8372 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8373 end do
8374 end if
8375
8376
8377# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8378#if defined(MFC_OpenACC)
8379# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8380!$acc loop seq
8381# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8382#elif defined(MFC_OpenMP)
8383# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8384
8385# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8386#endif
8387 do i = 1, num_fluids
8388 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8389 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
8390 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
8391 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8392
8393 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
8394 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
8395 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
8396 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
8397 end do
8398
8399 re_max = 0
8400 if (re_size(1) > 0) re_max = 1
8401 if (re_size(2) > 0) re_max = 2
8402
8403 if (viscous) then
8404
8405# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8406#if defined(MFC_OpenACC)
8407# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8408!$acc loop seq
8409# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8410#elif defined(MFC_OpenMP)
8411# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8412
8413# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8414#endif
8415 do i = 1, re_max
8416 re_l(i) = 0._wp
8417 re_r(i) = 0._wp
8418
8419
8420# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8421#if defined(MFC_OpenACC)
8422# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8423!$acc loop seq
8424# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8425#elif defined(MFC_OpenMP)
8426# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8427
8428# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8429#endif
8430 do q = 1, re_size(i)
8431 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
8432 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
8433 end do
8434
8435 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8436 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8437 end do
8438 end if
8439
8440 if (chemistry) then
8441 c_sum_yi_phi = 0.0_wp
8442
8443# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8444#if defined(MFC_OpenACC)
8445# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8446!$acc loop seq
8447# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8448#elif defined(MFC_OpenMP)
8449# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8450
8451# 1269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8452#endif
8453 do i = eqn_idx%species%beg, eqn_idx%species%end
8454 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8455 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
8456 end do
8457
8458 call get_mixture_molecular_weight(ys_l, mw_l)
8459 call get_mixture_molecular_weight(ys_r, mw_r)
8460
8461 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8462 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8463
8464 r_gas_l = gas_constant/mw_l
8465 r_gas_r = gas_constant/mw_r
8466
8467 t_l = pres_l/rho_l/r_gas_l
8468 t_r = pres_r/rho_r/r_gas_r
8469
8470 call get_species_specific_heats_r(t_l, cp_il)
8471 call get_species_specific_heats_r(t_r, cp_ir)
8472
8473 if (chem_params%gamma_method == 1) then
8474 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8475 gamma_il = cp_il/(cp_il - 1.0_wp)
8476 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8477
8478 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8479 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8480 else if (chem_params%gamma_method == 2) then
8481 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8482 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8483 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8484 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8485 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8486
8487 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8488 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8489 end if
8490
8491 call get_mixture_energy_mass(t_l, ys_l, e_l)
8492 call get_mixture_energy_mass(t_r, ys_r, e_r)
8493
8494 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8495 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8496 h_l = (e_l + pres_l)/rho_l
8497 h_r = (e_r + pres_r)/rho_r
8498 else
8499 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8500 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8501
8502 h_l = (e_l + pres_l)/rho_l
8503 h_r = (e_r + pres_r)/rho_r
8504 end if
8505
8506 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8507 if (hypoelasticity) then
8508
8509# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8510#if defined(MFC_OpenACC)
8511# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8512!$acc loop seq
8513# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8514#elif defined(MFC_OpenMP)
8515# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8516
8517# 1325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8518#endif
8519 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8520 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8521 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
8522 end do
8523 g_l = 0._wp
8524 g_r = 0._wp
8525
8526# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8527#if defined(MFC_OpenACC)
8528# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8529!$acc loop seq
8530# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8531#elif defined(MFC_OpenMP)
8532# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8533
8534# 1332 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8535#endif
8536 do i = 1, num_fluids
8537 g_l = g_l + alpha_l(i)*gs_rs(i)
8538 g_r = g_r + alpha_r(i)*gs_rs(i)
8539 end do
8540
8541# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8542#if defined(MFC_OpenACC)
8543# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8544!$acc loop seq
8545# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8546#elif defined(MFC_OpenMP)
8547# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8548
8549# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8550#endif
8551 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8552 ! Elastic contribution to energy if G large enough
8553 if ((g_l > verysmall) .and. (g_r > verysmall)) then
8554 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8555 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8556 ! Additional terms in 2D and 3D
8557 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
8558 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8559 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8560 end if
8561 end if
8562 end do
8563 end if
8564
8565 ! Hyperelastic stress contribution: strain energy added to total energy
8566 if (hyperelasticity) then
8567
8568# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8569#if defined(MFC_OpenACC)
8570# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8571!$acc loop seq
8572# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8573#elif defined(MFC_OpenMP)
8574# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8575
8576# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8577#endif
8578 do i = 1, num_dims
8579 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
8580 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
8581 end do
8582 g_l = 0._wp
8583 g_r = 0._wp
8584
8585# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8586#if defined(MFC_OpenACC)
8587# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8588!$acc loop seq
8589# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8590#elif defined(MFC_OpenMP)
8591# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8592
8593# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8594#endif
8595 do i = 1, num_fluids
8596 ! Mixture left and right shear modulus
8597 g_l = g_l + alpha_l(i)*gs_rs(i)
8598 g_r = g_r + alpha_r(i)*gs_rs(i)
8599 end do
8600 ! Elastic contribution to energy if G large enough
8601 if (g_l > verysmall .and. g_r > verysmall) then
8602 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
8603 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
8604 end if
8605
8606# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8607#if defined(MFC_OpenACC)
8608# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8609!$acc loop seq
8610# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8611#elif defined(MFC_OpenMP)
8612# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8613
8614# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8615#endif
8616 do i = 1, b_size - 1
8617 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8618 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
8619 end do
8620 end if
8621
8622 h_l = (e_l + pres_l)/rho_l
8623 h_r = (e_r + pres_r)/rho_r
8624
8625 if (avg_state == avg_state_roe) then
8626# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8627 rho_avg = sqrt(rho_l*rho_r)
8628# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8629
8630# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8631 vel_avg_rms = 0._wp
8632# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8633
8634# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8635
8636# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8637#if defined(MFC_OpenACC)
8638# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8639!$acc loop seq
8640# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8641#elif defined(MFC_OpenMP)
8642# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8643
8644# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8645#endif
8646# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8647 do i = 1, num_vels
8648# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8649 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
8650# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8651 end do
8652# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8653
8654# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8655 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8656# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8657
8658# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8659 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8660# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8661
8662# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8663 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
8664# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8665
8666# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8667 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8668# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8669
8670# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8671 if (chemistry) then
8672# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8673 eps = 0.001_wp
8674# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8675 call get_species_enthalpies_rt(t_l, h_il)
8676# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8677 call get_species_enthalpies_rt(t_r, h_ir)
8678# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8679 h_il = h_il*gas_constant/molecular_weights*t_l
8680# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8681 h_ir = h_ir*gas_constant/molecular_weights*t_r
8682# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8683 call get_species_specific_heats_r(t_l, cp_il)
8684# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8685 call get_species_specific_heats_r(t_r, cp_ir)
8686# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8687
8688# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8689 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8690# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8691 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8692# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8693 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8694# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8695 if (abs(t_l - t_r) < eps) then
8696# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8697 ! Case when T_L and T_R are very close
8698# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8699 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8700# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8701 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8702# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8703 & - gas_constant/molecular_weights(:)))
8704# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8705 else
8706# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8707 ! Normal calculation when T_L and T_R are sufficiently different
8708# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8709 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8710# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8711 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8712# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8713 end if
8714# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8715 gamma_avg = cp_avg/cv_avg
8716# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8717
8718# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8719 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8720# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8721 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8722# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8723 end if
8724# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8725 end if
8726# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8727
8728# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8729 if (avg_state == avg_state_arithmetic) then
8730# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8731 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8732# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8733 vel_avg_rms = 0._wp
8734# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8735
8736# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8737#if defined(MFC_OpenACC)
8738# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8739!$acc loop seq
8740# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8741#elif defined(MFC_OpenMP)
8742# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8743
8744# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8745#endif
8746# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8747 do i = 1, num_vels
8748# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8749 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8750# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8751 end do
8752# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8753
8754# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8755 h_avg = 5.e-1_wp*(h_l + h_r)
8756# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8757 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8758# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8759 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8760# 1382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8761 end if
8762
8763 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8764 & c_l, qv_l)
8765
8766 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8767 & c_r, qv_r)
8768
8769 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8770 ! variables are placeholders to call the subroutine.
8771 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8772 & c_sum_yi_phi, c_avg, qv_avg)
8773
8774 if (viscous) then
8775 if (chemistry) then
8776 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8777 end if
8778
8779# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8780#if defined(MFC_OpenACC)
8781# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8782!$acc loop seq
8783# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8784#elif defined(MFC_OpenMP)
8785# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8786
8787# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8788#endif
8789 do i = 1, 2
8790 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8791 end do
8792 end if
8793
8794 ! Low Mach correction
8795 if (low_mach == 2) then
8796 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8797# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8798 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8799# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8800 pcorr = 0._wp
8801# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8802
8803# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8804 if (low_mach == 1) then
8805# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8806 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8807# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8808 end if
8809# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8810 else if (riemann_solver == riemann_solver_hllc) then
8811# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8812 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8813# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8814 pcorr = 0._wp
8815# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8816
8817# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8818 if (low_mach == 1) then
8819# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8820 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))) &
8821# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8822 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8823# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8824 else if (low_mach == 2) then
8825# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8826 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))))
8827# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8828 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))))
8829# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8830 vel_l(dir_idx(1)) = vel_l_tmp
8831# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8832 vel_r(dir_idx(1)) = vel_r_tmp
8833# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8834 end if
8835# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8836 end if
8837 end if
8838
8839 if (wave_speeds == wave_speeds_direct) then
8840 if (elasticity) then
8841 ! Elastic wave speed, Rodriguez et al. JCP (2019)
8842 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
8843 & ))/rho_l), &
8844 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
8845 & + tau_e_r(dir_idx_tau(1)))/rho_r))
8846 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
8847 & ))/rho_r), &
8848 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
8849 & + tau_e_l(dir_idx_tau(1)))/rho_l))
8850 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
8851 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
8852 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
8853 & - vel_r(dir_idx(1))))
8854 else
8855 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8856 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8857 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8858 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
8859 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
8860 end if
8861 else if (wave_speeds == wave_speeds_pressure) then
8862 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8863
8864 pres_sr = pres_sl
8865
8866 ! Low Mach correction: Thornber et al. JCP (2008)
8867 ms_l = max(1._wp, &
8868 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8869 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8870 ms_r = max(1._wp, &
8871 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8872 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8873
8874 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8875 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8876
8877 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8878 end if
8879
8880 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8881 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8882
8883 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8884 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8885 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8886 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
8887 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8888 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8889
8890 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8891 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8892 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8893
8894 ! Low Mach correction
8895 if (low_mach == 1) then
8896 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8897# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8898 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8899# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8900 pcorr = 0._wp
8901# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8902
8903# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8904 if (low_mach == 1) then
8905# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8906 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8907# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8908 end if
8909# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8910 else if (riemann_solver == riemann_solver_hllc) then
8911# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8912 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8913# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8914 pcorr = 0._wp
8915# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8916
8917# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8918 if (low_mach == 1) then
8919# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8920 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))) &
8921# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8922 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8923# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8924 else if (low_mach == 2) then
8925# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8926 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))))
8927# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8928 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))))
8929# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8930 vel_l(dir_idx(1)) = vel_l_tmp
8931# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8932 vel_r(dir_idx(1)) = vel_r_tmp
8933# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8934 end if
8935# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8936 end if
8937 else
8938 pcorr = 0._wp
8939 end if
8940
8941 ! COMPUTING THE HLLC FLUXES MASS FLUX.
8942
8943# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8944#if defined(MFC_OpenACC)
8945# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8946!$acc loop seq
8947# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8948#elif defined(MFC_OpenMP)
8949# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8950
8951# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8952#endif
8953 do i = 1, eqn_idx%cont%end
8954 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8955 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8956 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8957 end do
8958
8959 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
8960 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
8961
8962# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8963#if defined(MFC_OpenACC)
8964# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8965!$acc loop seq
8966# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8967#elif defined(MFC_OpenMP)
8968# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8969
8970# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8971#endif
8972 do i = 1, num_dims
8973 flux_rsx_vf(j, k, l, &
8974 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
8975 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
8976 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
8977 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
8978 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
8979 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8980 end do
8981
8982 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
8983 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
8984 flux_rsx_vf(j, k, l, &
8985 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 + xi_l*(s_s &
8986 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
8987 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
8988 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
8989 & *(s_p/s_r)*pcorr*s_s
8990
8991 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
8992 if (elasticity) then
8993 flux_ene_e = 0._wp
8994
8995# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8996#if defined(MFC_OpenACC)
8997# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8998!$acc loop seq
8999# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9000#elif defined(MFC_OpenMP)
9001# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9002
9003# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9004#endif
9005 do i = 1, num_dims
9006 ! MOMENTUM ELASTIC FLUX.
9007 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
9008 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
9009 & - xi_p*tau_e_r(dir_idx_tau(i))
9010 ! ENERGY ELASTIC FLUX.
9011 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
9012 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
9013 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
9014 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
9015 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
9016 end do
9017 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
9018 end if
9019
9020 ! HYPOELASTIC STRESS EVOLUTION FLUX.
9021 if (hypoelasticity) then
9022
9023# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9024#if defined(MFC_OpenACC)
9025# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9026!$acc loop seq
9027# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9028#elif defined(MFC_OpenMP)
9029# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9030
9031# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9032#endif
9033 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9034 flux_rsx_vf(j, k, l, &
9035 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
9036 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9037 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
9038 end do
9039 end if
9040
9041 ! VOLUME FRACTION FLUX.
9042
9043# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9044#if defined(MFC_OpenACC)
9045# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9046!$acc loop seq
9047# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9048#elif defined(MFC_OpenMP)
9049# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9050
9051# 1533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9052#endif
9053 do i = eqn_idx%adv%beg, eqn_idx%adv%end
9054 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9055 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
9056 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9057 end do
9058
9059 ! VOLUME FRACTION SOURCE FLUX.
9060
9061# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9062#if defined(MFC_OpenACC)
9063# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9064!$acc loop seq
9065# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9066#elif defined(MFC_OpenMP)
9067# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9068
9069# 1541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9070#endif
9071 do i = 1, num_dims
9072 vel_src_rsx_vf(j, k, l, &
9073 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
9074 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
9075 end do
9076
9077 ! COLOR FUNCTION FLUX
9078 if (surface_tension) then
9079 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
9080 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9081 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9082 end if
9083
9084 ! Hyperelastic reference map flux for material deformation tracking
9085 if (hyperelasticity) then
9086
9087# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9088#if defined(MFC_OpenACC)
9089# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9090!$acc loop seq
9091# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9092#elif defined(MFC_OpenMP)
9093# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9094
9095# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9096#endif
9097 do i = 1, num_dims
9098 flux_rsx_vf(j, k, l, &
9099 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
9100 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9101 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
9102 end do
9103 end if
9104
9105 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9106
9107 if (chemistry) then
9108
9109# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9110#if defined(MFC_OpenACC)
9111# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9112!$acc loop seq
9113# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9114#elif defined(MFC_OpenMP)
9115# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9116
9117# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9118#endif
9119 do i = eqn_idx%species%beg, eqn_idx%species%end
9120 y_l = ql_prim_rsx_vf(j, k, l, i)
9121 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
9122
9123 flux_rsx_vf(j, k, l, &
9124 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9125 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9126 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9127 end do
9128 end if
9129
9130 ! Geometrical source flux for cylindrical coordinates
9131# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9132# 1605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9133 if (grid_geometry == 3) then
9134
9135# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9136#if defined(MFC_OpenACC)
9137# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9138!$acc loop seq
9139# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9140#elif defined(MFC_OpenMP)
9141# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9142
9143# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9144#endif
9145 do i = 1, sys_size
9146 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
9147 end do
9148
9149 flux_gsrc_rsx_vf(j, k, l, &
9150 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
9151 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
9152 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
9153 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
9154 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
9155 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
9156 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
9157 end if
9158# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9159 end do
9160 end do
9161 end do
9162
9163# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9164#if defined(MFC_OpenACC)
9165# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9166!$acc end parallel loop
9167# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9168#elif defined(MFC_OpenMP)
9169# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9170
9171# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9172!$omp end target teams loop
9173# 1624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9174#endif
9175 end if
9176 end if
9177# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9178 ! Computing HLLC flux and source flux for Euler system of equations
9179
9180 if (viscous) then
9181 if (weno_re_flux) then
9182 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9183 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9184 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9185 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9186 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9187 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9188 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9189 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
9190 & norm_dir, ix, iy, iz)
9191 else
9192 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9193 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9194 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9195 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9196 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9197 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9198 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9199 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
9200 & norm_dir, ix, iy, iz)
9201 end if
9202 end if
9203
9204 if (surface_tension) then
9205 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
9206 end if
9207
9208 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
9209
9210 end subroutine s_hllc_riemann_solver
9211
9212end 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:317
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:354
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:354
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:354
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged models.
Definition m_bubbles.fpp.f90:317
m_bubbles::f_cpbw_km
elemental real(wp) function f_cpbw_km(fr0, fr, fv, fpb)
Keller-Miksis bubble wall pressure.
Definition m_bubbles.fpp.f90:616
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:329
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:369
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_4eq
integer, parameter model_eqns_4eq
Definition m_constants.fpp.f90:136
m_constants::model_eqns_5eq
integer, parameter model_eqns_5eq
Definition m_constants.fpp.f90:134
m_constants::avg_state_roe
integer, parameter avg_state_roe
Definition m_constants.fpp.f90:123
m_constants::wave_speeds_direct
integer, parameter wave_speeds_direct
Definition m_constants.fpp.f90:156
m_constants::riemann_solver_hll
integer, parameter riemann_solver_hll
Definition m_constants.fpp.f90:149
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:150
m_constants::wave_speeds_pressure
integer, parameter wave_speeds_pressure
Definition m_constants.fpp.f90:157
m_constants::riemann_solver_lax_friedrichs
integer, parameter riemann_solver_lax_friedrichs
Definition m_constants.fpp.f90:152
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:124
m_constants::model_eqns_6eq
integer, parameter model_eqns_6eq
Definition m_constants.fpp.f90:135
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:597
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:372
m_global_parameters::re_idx
integer, dimension(:,:), allocatable re_idx
Definition m_global_parameters.fpp.f90:599
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:748
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:656
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:658
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:749
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:894
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:894
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:657
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:732
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:894
m_riemann_solver_hllc
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solver_hllc.fpp.f90:337
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:362
m_riemann_state
Shared Riemann-solver module state and the per-sweep setup, state-buffer population,...
Definition m_riemann_state.fpp.f90:329
m_riemann_state::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_state.fpp.f90:342
m_riemann_state::isz
type(int_bounds_info) isz
Definition m_riemann_state.fpp.f90:417
m_riemann_state::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_state.fpp.f90:388
m_riemann_state::isx
type(int_bounds_info) isx
Definition m_riemann_state.fpp.f90:417
m_riemann_state::is3
type(int_bounds_info) is3
Definition m_riemann_state.fpp.f90:416
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:342
m_riemann_state::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_state.fpp.f90:445
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:1568
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:466
m_riemann_state::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_state.fpp.f90:432
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:489
m_riemann_state::isy
type(int_bounds_info) isy
Definition m_riemann_state.fpp.f90:417
m_riemann_state::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_state.fpp.f90:375
m_riemann_state::is2
type(int_bounds_info) is2
Definition m_riemann_state.fpp.f90:416
m_riemann_state::s_finalize_riemann_solver
subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
Deallocation and/or disassociation procedures that are needed to finalize the selected Riemann proble...
Definition m_riemann_state.fpp.f90:2527
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:359
m_riemann_state::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_state.fpp.f90:401
m_riemann_state::is1
type(int_bounds_info) is1
Definition m_riemann_state.fpp.f90:416
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:331
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:595
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_variables_conversion::s_compute_speed_of_sound
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state ...
Definition m_variables_conversion.fpp.f90:2558
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:411
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331