MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_riemann_solver_hllc.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2!>
3!! @file
4!! @brief Contains module m_riemann_solver_hllc
5
6!> @brief HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
7# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
8! This file exists so that Fypp can be run without generating case.fpp files for
9! each target. This is useful when generating documentation, for example. This
10! should also let MFC be built with CMake directly, without invoking mfc.sh.
11
12! For pre-process.
13# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
14
15! For moving immersed boundaries in simulation
16# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
17# 7 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
18# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
19# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
20# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
21# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44
45# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46! New line at end of file is required for FYPP
47# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
48# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
49# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
50# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75! New line at end of file is required for FYPP
76# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
77
78# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154! New line at end of file is required for FYPP
155# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
156# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
157# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
158# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183! New line at end of file is required for FYPP
184# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
185
186# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241! New line at end of file is required for FYPP
242# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
243
244! GPU parallel region (scalar reductions, maxval/minval)
245# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! GPU parallel loop over threads (most common GPU macro)
248# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Required closing for GPU_PARALLEL_LOOP
251# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Mark routine for device compilation
254# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Declare device-resident data
257# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Inner loop within a GPU parallel region
260# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Scoped GPU data region
263# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! Host code with device pointers (for MPI with GPU buffers)
266# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Allocate device memory (unscoped)
269# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Free device memory
272# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Atomic operation on device
275# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! End atomic capture block
278# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Copy data between host and device
281# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Synchronization barrier
284# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Import GPU library module (openacc or omp_lib)
287# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Emit code only for AMD compiler
290# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Emit code for non-Cray compilers
293# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Emit code only for Cray compiler
296# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Emit code for non-NVIDIA compilers
299# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
302# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303! New line at end of file is required for FYPP
304# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
305
306# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
309! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
310! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
311# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Allocate and create GPU device memory
314# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316! Free GPU device memory and deallocate
317# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
318
319! Cray-specific GPU pointer setup for vector fields
320# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322! Cray-specific GPU pointer setup for scalar fields
323# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325! Cray-specific GPU pointer setup for acoustic source spatials
326# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329
330# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
331! New line at end of file is required for FYPP
332# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
333# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
334# 13 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
335
336# 60 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
337
338# 70 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
339
340# 94 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
341# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp" 2
342
343module m_riemann_solver_hllc
344
345 use m_derived_types
346 use m_global_parameters
347 use m_variables_conversion
348 use m_bubbles
349 use m_constants, only: riemann_solver_hll, riemann_solver_hllc, riemann_solver_lax_friedrichs, model_eqns_5eq, &
350 & model_eqns_6eq, model_eqns_4eq, avg_state_roe, avg_state_arithmetic, wave_speeds_direct, wave_speeds_pressure
351 use m_bubbles_ee
352 use m_surface_tension
353 use m_chemistry
354 use m_thermochem, only: gas_constant, get_mixture_molecular_weight, get_mixture_specific_heat_cv_mass, &
355 & get_mixture_energy_mass, get_species_specific_heats_r, get_species_enthalpies_rt, get_mixture_specific_heat_cp_mass, &
356 & molecular_weights
357 use m_riemann_state
358
359 implicit none
360
361contains
362
363 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
364 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, &
365 & dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
366 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
367
368 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
369 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
370 type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf
371 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
372 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
373
374 ! Intercell fluxes
375 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
376 integer, intent(in) :: norm_dir
377 type(int_bounds_info), intent(in) :: ix, iy, iz
378
379# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
380 real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R
381 real(wp), dimension(num_fluids) :: alpha_L, alpha_R
382 real(wp), dimension(num_dims) :: vel_L, vel_R
383# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
384
385 real(wp) :: rho_L, rho_R
386 real(wp) :: pres_L, pres_R
387 real(wp) :: E_L, E_R
388 real(wp) :: H_L, H_R
389# 64 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
390 real(wp), dimension(num_species) :: Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR
391 real(wp), dimension(num_species) :: Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2
392# 67 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
393 real(wp) :: Cp_avg, Cv_avg, T_avg, c_sum_Yi_Phi, eps
394 real(wp) :: T_L, T_R
395 real(wp) :: MW_L, MW_R
396 real(wp) :: R_gas_L, R_gas_R
397 real(wp) :: Cp_L, Cp_R
398 real(wp) :: Cv_L, Cv_R
399 real(wp) :: Gamm_L, Gamm_R
400 real(wp) :: Y_L, Y_R
401 real(wp) :: gamma_L, gamma_R
402 real(wp) :: pi_inf_L, pi_inf_R
403 real(wp) :: qv_L, qv_R
404 real(wp) :: c_L, c_R
405 real(wp), dimension(2) :: Re_L, Re_R
406 real(wp) :: rho_avg
407 real(wp) :: H_avg
408 real(wp) :: gamma_avg
409 real(wp) :: qv_avg
410 real(wp) :: c_avg
411 real(wp) :: s_L, s_R, s_M, s_P, s_S
412 real(wp) :: xi_L, xi_R !< Left and right wave speeds functions
413 real(wp) :: xi_L_m1, xi_R_m1 !< xi_L/R - 1, computed without cancellation
414 real(wp) :: xi_M, xi_P
415 real(wp) :: xi_MP, xi_PP
416# 96 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
417 real(wp), dimension(nb) :: R0_L, R0_R
418 real(wp), dimension(nb) :: V0_L, V0_R
419 real(wp), dimension(nb) :: P0_L, P0_R
420 real(wp), dimension(nb) :: pbw_L, pbw_R
421# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
422
423 real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L, nbub_R
424 real(wp) :: ptilde_L, ptilde_R
425 real(wp) :: PbwR3Lbar, PbwR3Rbar
426 real(wp) :: R3Lbar, R3Rbar
427 real(wp) :: R3V2Lbar, R3V2Rbar
428 real(wp), dimension(6) :: tau_e_L, tau_e_R
429# 111 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
430 real(wp), dimension(num_dims) :: xi_field_L, xi_field_R
431# 113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
432 real(wp) :: G_L, G_R
433 real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms
434 real(wp) :: vel_L_tmp, vel_R_tmp
435 real(wp) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_star
436 real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R
437 real(wp) :: flux_ene_e
438 real(wp) :: zcoef, pcorr !< low Mach number correction
439 integer :: Re_max, i, j, k, l, q !< Generic loop iterators
440 integer :: Re_size_loc1, Re_size_loc2 !< host copy of Re_size; amdflang reads the declare-target original stale cross-TU
441 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
442
443 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
444 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
445
446 ! Reshaping inputted data based on dimensional splitting direction
447
448 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
449 re_size_loc1 = re_size(1); re_size_loc2 = re_size(2)
450
451# 136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
452# 137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
453# 138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
454 if (norm_dir == 1) then
455 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
456 if (model_eqns == model_eqns_6eq) then
457 ! 6-equation model (model_eqns=3): separate phasic internal energies
458
459# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
460
461# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
462#if defined(MFC_OpenACC)
463# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
464!$acc parallel loop collapse(3) gang vector default(present) &
465# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
466!$acc& 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) &
467# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
468!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
469# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
470#elif defined(MFC_OpenMP)
471# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
472
473# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
474
475# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
476
477# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
478!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
479# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
480!$omp& 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) &
481# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
482!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
483# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
484#endif
485# 152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
486 do l = is3%beg, is3%end
487 do k = is2%beg, is2%end
488 do j = is1%beg, is1%end
489 vel_l_rms = 0._wp; vel_r_rms = 0._wp
490 rho_l = 0._wp; rho_r = 0._wp
491 gamma_l = 0._wp; gamma_r = 0._wp
492 pi_inf_l = 0._wp; pi_inf_r = 0._wp
493 qv_l = 0._wp; qv_r = 0._wp
494 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
495
496
497# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
498#if defined(MFC_OpenACC)
499# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
500!$acc loop seq
501# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
502#elif defined(MFC_OpenMP)
503# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
504
505# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
506#endif
507 do i = 1, num_dims
508 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
509 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
510 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
511 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
512 end do
513
514 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
515 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
516
517 rho_l = 0._wp
518 gamma_l = 0._wp
519 pi_inf_l = 0._wp
520 qv_l = 0._wp
521
522 rho_r = 0._wp
523 gamma_r = 0._wp
524 pi_inf_r = 0._wp
525 qv_r = 0._wp
526
527 alpha_l_sum = 0._wp
528 alpha_r_sum = 0._wp
529
530 if (mpp_lim) then
531
532# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
533#if defined(MFC_OpenACC)
534# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
535!$acc loop seq
536# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
537#elif defined(MFC_OpenMP)
538# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
539
540# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
541#endif
542 do i = 1, num_fluids
543 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
544 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
545 & eqn_idx%E + i)), 1._wp)
546 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
547 end do
548
549
550# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
551#if defined(MFC_OpenACC)
552# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
553!$acc loop seq
554# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
555#elif defined(MFC_OpenMP)
556# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
557
558# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
559#endif
560 do i = 1, num_fluids
561 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
562 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
563 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
564 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
565 end do
566
567
568# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
569#if defined(MFC_OpenACC)
570# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
571!$acc loop seq
572# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
573#elif defined(MFC_OpenMP)
574# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
575
576# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
577#endif
578 do i = 1, num_fluids
579 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
580 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
581 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
582 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
583 end do
584 end if
585
586
587# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
588#if defined(MFC_OpenACC)
589# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
590!$acc loop seq
591# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
592#elif defined(MFC_OpenMP)
593# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
594
595# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
596#endif
597 do i = 1, num_fluids
598 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
599 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
600 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
601 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
602
603 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
604 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
605 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
606 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
607
608 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
609 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
610 end do
611
612 if (viscous) then
613
614# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
615#if defined(MFC_OpenACC)
616# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
617!$acc loop seq
618# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
619#elif defined(MFC_OpenMP)
620# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
621
622# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
623#endif
624 do i = 1, 2
625 re_l(i) = dflt_real
626 re_r(i) = dflt_real
627 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
628 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
629
630# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
631#if defined(MFC_OpenACC)
632# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
633!$acc loop seq
634# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
635#elif defined(MFC_OpenMP)
636# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
637
638# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
639#endif
640 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
641 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
642 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
643 & q) + re_r(i)
644 end do
645 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
646 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
647 end do
648 end if
649
650 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
651 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
652
653 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
654 if (hypoelasticity) then
655
656# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
657#if defined(MFC_OpenACC)
658# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
659!$acc loop seq
660# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
661#elif defined(MFC_OpenMP)
662# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
663
664# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
665#endif
666 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
667 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
668 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
669 end do
670 g_l = 0._wp; g_r = 0._wp
671
672# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
673#if defined(MFC_OpenACC)
674# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
675!$acc loop seq
676# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
677#elif defined(MFC_OpenMP)
678# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
679
680# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
681#endif
682 do i = 1, num_fluids
683 g_l = g_l + alpha_l(i)*gs_rs(i)
684 g_r = g_r + alpha_r(i)*gs_rs(i)
685 end do
686
687# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
688#if defined(MFC_OpenACC)
689# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
690!$acc loop seq
691# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
692#elif defined(MFC_OpenMP)
693# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
694
695# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
696#endif
697 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
698 ! Elastic contribution to energy if G large enough
699 if ((g_l > verysmall) .and. (g_r > verysmall)) then
700 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
701 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
702 ! Additional terms in 2D and 3D
703 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
704 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
705 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
706 end if
707 end if
708 end do
709 end if
710
711 ! Hyperelastic stress contribution: strain energy added to total energy
712 if (hyperelasticity) then
713
714# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
715#if defined(MFC_OpenACC)
716# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
717!$acc loop seq
718# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
719#elif defined(MFC_OpenMP)
720# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
721
722# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
723#endif
724 do i = 1, num_dims
725 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
726 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
727 end do
728 g_l = 0._wp; g_r = 0._wp
729
730# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
731#if defined(MFC_OpenACC)
732# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
733!$acc loop seq
734# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
735#elif defined(MFC_OpenMP)
736# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
737
738# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
739#endif
740 do i = 1, num_fluids
741 ! Mixture left and right shear modulus
742 g_l = g_l + alpha_l(i)*gs_rs(i)
743 g_r = g_r + alpha_r(i)*gs_rs(i)
744 end do
745 ! Elastic contribution to energy if G large enough
746 if (g_l > verysmall .and. g_r > verysmall) then
747 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
748 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
749 end if
750
751# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
752#if defined(MFC_OpenACC)
753# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
754!$acc loop seq
755# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
756#elif defined(MFC_OpenMP)
757# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
758
759# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
760#endif
761 do i = 1, b_size - 1
762 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
763 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
764 end do
765 end if
766
767 h_l = (e_l + pres_l)/rho_l
768 h_r = (e_r + pres_r)/rho_r
769
770 if (avg_state == avg_state_roe) then
771# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
772 rho_avg = sqrt(rho_l*rho_r)
773# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
774
775# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
776 vel_avg_rms = 0._wp
777# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
778
779# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
780
781# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
782#if defined(MFC_OpenACC)
783# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
784!$acc loop seq
785# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
786#elif defined(MFC_OpenMP)
787# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
788
789# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
790#endif
791# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
792 do i = 1, num_vels
793# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
794 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
795# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
796 end do
797# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
798
799# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
800 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
801# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
802
803# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
804 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
805# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
806
807# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
808 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
809# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
810
811# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
812 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
813# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
814
815# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
816 if (chemistry) then
817# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
818 eps = 0.001_wp
819# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
820 call get_species_enthalpies_rt(t_l, h_il)
821# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
822 call get_species_enthalpies_rt(t_r, h_ir)
823# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
824 h_il = h_il*gas_constant/molecular_weights*t_l
825# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
826 h_ir = h_ir*gas_constant/molecular_weights*t_r
827# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
828 call get_species_specific_heats_r(t_l, cp_il)
829# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
830 call get_species_specific_heats_r(t_r, cp_ir)
831# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
832
833# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
834 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
835# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
836 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
837# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
838 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
839# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
840 if (abs(t_l - t_r) < eps) then
841# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
842 ! Case when T_L and T_R are very close
843# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
844 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
845# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
846 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
847# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
848 & - gas_constant/molecular_weights(:)))
849# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
850 else
851# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
852 ! Normal calculation when T_L and T_R are sufficiently different
853# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
854 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
855# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
856 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
857# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
858 end if
859# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
860 gamma_avg = cp_avg/cv_avg
861# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
862
863# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
864 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
865# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
866 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
867# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
868 end if
869# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
870 end if
871# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
872
873# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
874 if (avg_state == avg_state_arithmetic) then
875# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
876 rho_avg = 5.e-1_wp*(rho_l + rho_r)
877# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
878 vel_avg_rms = 0._wp
879# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
880
881# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
882#if defined(MFC_OpenACC)
883# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
884!$acc loop seq
885# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
886#elif defined(MFC_OpenMP)
887# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
888
889# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
890#endif
891# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
892 do i = 1, num_vels
893# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
894 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
895# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
896 end do
897# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
898
899# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
900 h_avg = 5.e-1_wp*(h_l + h_r)
901# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
902 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
903# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
904 qv_avg = 5.e-1_wp*(qv_l + qv_r)
905# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
906 end if
907
908 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
909 & c_l, qv_l)
910
911 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
912 & c_r, qv_r)
913
914 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
915 ! variables are placeholders to call the subroutine.
916 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
917 & 0._wp, c_avg, qv_avg)
918
919 if (viscous) then
920
921# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
922#if defined(MFC_OpenACC)
923# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
924!$acc loop seq
925# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
926#elif defined(MFC_OpenMP)
927# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
928
929# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
930#endif
931 do i = 1, 2
932 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
933 end do
934 end if
935
936 ! Low Mach correction
937 if (low_mach == 2) then
938 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
939# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
940 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
941# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
942 pcorr = 0._wp
943# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
944
945# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
946 if (low_mach == 1) then
947# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
948 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
949# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
950 end if
951# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
952 else if (riemann_solver == riemann_solver_hllc) then
953# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
954 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
955# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
956 pcorr = 0._wp
957# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
958
959# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
960 if (low_mach == 1) then
961# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
962 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))) &
963# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
964 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
965# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
966 else if (low_mach == 2) then
967# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
968 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))))
969# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
970 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))))
971# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
972 vel_l(dir_idx(1)) = vel_l_tmp
973# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
974 vel_r(dir_idx(1)) = vel_r_tmp
975# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
976 end if
977# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
978 end if
979 end if
980
981 ! COMPUTING THE DIRECT WAVE SPEEDS
982 if (wave_speeds == wave_speeds_direct) then
983 if (elasticity) then
984 ! Elastic wave speed, Rodriguez et al. JCP (2019)
985 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) &
986 & ))/rho_l), &
987 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
988 & + tau_e_r(dir_idx_tau(1)))/rho_r))
989 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) &
990 & ))/rho_r), &
991 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
992 & + tau_e_l(dir_idx_tau(1)))/rho_l))
993 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
994 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
995 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
996 & - vel_r(dir_idx(1))))
997 else
998 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
999 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1000 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1001 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
1002 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
1003 end if
1004 else if (wave_speeds == wave_speeds_pressure) then
1005 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1006
1007 pres_sr = pres_sl
1008
1009 ! Low Mach correction: Thornber et al. JCP (2008)
1010 ms_l = max(1._wp, &
1011 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1012 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1013 ms_r = max(1._wp, &
1014 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1015 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1016
1017 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1018 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1019
1020 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1021 end if
1022
1023 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1024 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1025
1026 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1027 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1028 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1029 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1030 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1031
1032 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1033 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
1034 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
1035
1036 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
1037 xi_mp = -min(0._wp, sign(1._wp, s_l))
1038 xi_pp = max(0._wp, sign(1._wp, s_r))
1039
1040 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 &
1041 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
1042 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
1043 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
1044 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
1045
1046 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))
1047
1048 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 &
1049 & - vel_r(dir_idx(1)))
1050
1051 ! Low Mach correction
1052 if (low_mach == 1) then
1053 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
1054# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1055 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1056# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1057 pcorr = 0._wp
1058# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1059
1060# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1061 if (low_mach == 1) then
1062# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1063 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1064# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1065 end if
1066# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1067 else if (riemann_solver == riemann_solver_hllc) then
1068# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1069 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1070# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1071 pcorr = 0._wp
1072# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1073
1074# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1075 if (low_mach == 1) then
1076# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1077 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))) &
1078# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1079 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1080# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1081 else if (low_mach == 2) then
1082# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1083 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))))
1084# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1085 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))))
1086# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1087 vel_l(dir_idx(1)) = vel_l_tmp
1088# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1089 vel_r(dir_idx(1)) = vel_r_tmp
1090# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1091 end if
1092# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1093 end if
1094 else
1095 pcorr = 0._wp
1096 end if
1097
1098 ! COMPUTING FLUXES MASS FLUX.
1099
1100# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1101#if defined(MFC_OpenACC)
1102# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1103!$acc loop seq
1104# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1105#elif defined(MFC_OpenMP)
1106# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1107
1108# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1109#endif
1110 do i = 1, eqn_idx%cont%end
1111 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1112 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1113 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1114 end do
1115
1116 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1117
1118# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1119#if defined(MFC_OpenACC)
1120# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1121!$acc loop seq
1122# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1123#elif defined(MFC_OpenMP)
1124# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1125
1126# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1127#endif
1128 do i = 1, num_dims
1129 flux_rsx_vf(j, k, l, &
1130 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
1131 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
1132 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
1133 & *dir_flg(dir_idx(i))*pcorr
1134 end do
1135
1136 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
1137 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
1138
1139 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
1140 if (elasticity) then
1141 flux_ene_e = 0._wp
1142
1143# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1144#if defined(MFC_OpenACC)
1145# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1146!$acc loop seq
1147# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1148#elif defined(MFC_OpenMP)
1149# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1150
1151# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1152#endif
1153 do i = 1, num_dims
1154 ! MOMENTUM ELASTIC FLUX.
1155 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
1156 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
1157 & - xi_p*tau_e_r(dir_idx_tau(i))
1158 ! ENERGY ELASTIC FLUX.
1159 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
1160 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
1161 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
1162 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
1163 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
1164 end do
1165 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
1166 end if
1167
1168 ! VOLUME FRACTION FLUX.
1169
1170# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1171#if defined(MFC_OpenACC)
1172# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1173!$acc loop seq
1174# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1175#elif defined(MFC_OpenMP)
1176# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1177
1178# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1179#endif
1180 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1181 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1182 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
1183 end do
1184
1185 ! Advection velocity source: interface velocity for volume fraction transport
1186
1187# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1188#if defined(MFC_OpenACC)
1189# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1190!$acc loop seq
1191# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1192#elif defined(MFC_OpenMP)
1193# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1194
1195# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1196#endif
1197 do i = 1, num_dims
1198 vel_src_rsx_vf(j, k, l, &
1199 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1200 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
1201 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
1202 end do
1203
1204 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
1205 ! energy flux
1206
1207# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1208#if defined(MFC_OpenACC)
1209# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1210!$acc loop seq
1211# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1212#elif defined(MFC_OpenMP)
1213# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1214
1215# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1216#endif
1217 do i = 1, num_fluids
1218 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
1219 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
1220 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
1221 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
1222 & + pres_r)
1223
1224 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
1225 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1226 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
1227 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
1228 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1229 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
1230 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
1231 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1232 & i + eqn_idx%adv%beg - 1))
1233 end do
1234
1235 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1236
1237 ! HYPOELASTIC STRESS EVOLUTION FLUX.
1238 if (hypoelasticity) then
1239
1240# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1241#if defined(MFC_OpenACC)
1242# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1243!$acc loop seq
1244# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1245#elif defined(MFC_OpenMP)
1246# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1247
1248# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1249#endif
1250 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1251 flux_rsx_vf(j, k, l, &
1252 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
1253 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
1254 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
1255 end do
1256 end if
1257
1258 ! Hyperelastic reference map flux for material deformation tracking
1259 if (hyperelasticity) then
1260
1261# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1262#if defined(MFC_OpenACC)
1263# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1264!$acc loop seq
1265# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1266#elif defined(MFC_OpenMP)
1267# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1268
1269# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1270#endif
1271 do i = 1, num_dims
1272 flux_rsx_vf(j, k, l, &
1273 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
1274 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
1275 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
1276 end do
1277 end if
1278
1279 ! COLOR FUNCTION FLUX
1280 if (surface_tension) then
1281 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
1282 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
1283 end if
1284
1285 ! Geometrical source flux for cylindrical coordinates
1286# 538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1287# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1288 end do
1289 end do
1290 end do
1291
1292# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1293#if defined(MFC_OpenACC)
1294# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1295!$acc end parallel loop
1296# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1297#elif defined(MFC_OpenMP)
1298# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1299
1300# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1301!$omp end target teams loop
1302# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1303#endif
1304 else if (model_eqns == model_eqns_4eq) then
1305 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
1306
1307# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1308
1309# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1310#if defined(MFC_OpenACC)
1311# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1312!$acc parallel loop collapse(3) gang vector default(present) &
1313# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1314!$acc& 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)
1315# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1316#elif defined(MFC_OpenMP)
1317# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1318
1319# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1320
1321# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1322
1323# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1324!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1325# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1326!$omp& 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)
1327# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1328#endif
1329# 566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1330 do l = is3%beg, is3%end
1331 do k = is2%beg, is2%end
1332 do j = is1%beg, is1%end
1333 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1334 rho_l = 0._wp; rho_r = 0._wp
1335 gamma_l = 0._wp; gamma_r = 0._wp
1336 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1337 qv_l = 0._wp; qv_r = 0._wp
1338
1339
1340# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1341#if defined(MFC_OpenACC)
1342# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1343!$acc loop seq
1344# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1345#elif defined(MFC_OpenMP)
1346# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1347
1348# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1349#endif
1350 do i = 1, eqn_idx%cont%end
1351 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1352 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1353 end do
1354
1355
1356# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1357#if defined(MFC_OpenACC)
1358# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1359!$acc loop seq
1360# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1361#elif defined(MFC_OpenMP)
1362# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1363
1364# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1365#endif
1366 do i = 1, num_dims
1367 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1368 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1369 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1370 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1371 end do
1372
1373
1374# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1375#if defined(MFC_OpenACC)
1376# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1377!$acc loop seq
1378# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1379#elif defined(MFC_OpenMP)
1380# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1381
1382# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1383#endif
1384 do i = 1, num_fluids
1385 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1386 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1387 end do
1388
1389# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1390#if defined(MFC_OpenACC)
1391# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1392!$acc loop seq
1393# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1394#elif defined(MFC_OpenMP)
1395# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1396
1397# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1398#endif
1399 do i = 1, num_fluids
1400 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1401 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1402 end do
1403
1404
1405# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1406#if defined(MFC_OpenACC)
1407# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1408!$acc loop seq
1409# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1410#elif defined(MFC_OpenMP)
1411# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1412
1413# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1414#endif
1415 do i = 1, num_fluids
1416 rho_l = rho_l + alpha_rho_l(i)
1417 gamma_l = gamma_l + alpha_l(i)*gammas(i)
1418 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
1419 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
1420
1421 rho_r = rho_r + alpha_rho_r(i)
1422 gamma_r = gamma_r + alpha_r(i)*gammas(i)
1423 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
1424 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
1425 end do
1426
1427 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1428 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1429
1430 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
1431 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
1432
1433 h_l = (e_l + pres_l)/rho_l
1434 h_r = (e_r + pres_r)/rho_r
1435
1436 if (avg_state == avg_state_roe) then
1437# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1438 rho_avg = sqrt(rho_l*rho_r)
1439# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1440
1441# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1442 vel_avg_rms = 0._wp
1443# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1444
1445# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1446
1447# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1448#if defined(MFC_OpenACC)
1449# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1450!$acc loop seq
1451# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1452#elif defined(MFC_OpenMP)
1453# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1454
1455# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1456#endif
1457# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1458 do i = 1, num_vels
1459# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1460 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
1461# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1462 end do
1463# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1464
1465# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1466 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1467# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1468
1469# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1470 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1471# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1472
1473# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1474 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
1475# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1476
1477# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1478 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1479# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1480
1481# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1482 if (chemistry) then
1483# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1484 eps = 0.001_wp
1485# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1486 call get_species_enthalpies_rt(t_l, h_il)
1487# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1488 call get_species_enthalpies_rt(t_r, h_ir)
1489# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1490 h_il = h_il*gas_constant/molecular_weights*t_l
1491# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1492 h_ir = h_ir*gas_constant/molecular_weights*t_r
1493# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1494 call get_species_specific_heats_r(t_l, cp_il)
1495# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1496 call get_species_specific_heats_r(t_r, cp_ir)
1497# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1498
1499# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1500 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1501# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1502 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1503# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1504 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1505# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1506 if (abs(t_l - t_r) < eps) then
1507# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1508 ! Case when T_L and T_R are very close
1509# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1510 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1511# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1512 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
1513# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1514 & - gas_constant/molecular_weights(:)))
1515# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1516 else
1517# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1518 ! Normal calculation when T_L and T_R are sufficiently different
1519# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1520 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1521# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1522 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1523# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1524 end if
1525# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1526 gamma_avg = cp_avg/cv_avg
1527# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1528
1529# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1530 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1531# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1532 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1533# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1534 end if
1535# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1536 end if
1537# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1538
1539# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1540 if (avg_state == avg_state_arithmetic) then
1541# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1542 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1543# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1544 vel_avg_rms = 0._wp
1545# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1546
1547# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1548#if defined(MFC_OpenACC)
1549# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1550!$acc loop seq
1551# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1552#elif defined(MFC_OpenMP)
1553# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1554
1555# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1556#endif
1557# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1558 do i = 1, num_vels
1559# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1560 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1561# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1562 end do
1563# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1564
1565# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1566 h_avg = 5.e-1_wp*(h_l + h_r)
1567# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1568 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1569# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1570 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1571# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1572 end if
1573
1574 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
1575 & c_l, qv_l)
1576
1577 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
1578 & c_r, qv_r)
1579
1580 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1581 ! variables are placeholders to call the subroutine.
1582
1583 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1584 & 0._wp, c_avg, qv_avg)
1585
1586 if (wave_speeds == wave_speeds_direct) then
1587 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1588 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1589
1590 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1591 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1592 & - rho_r*(s_r - vel_r(dir_idx(1))))
1593 else if (wave_speeds == wave_speeds_pressure) then
1594 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1595
1596 pres_sr = pres_sl
1597
1598 ! Low Mach correction: Thornber et al. JCP (2008)
1599 ms_l = max(1._wp, &
1600 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1601 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1602 ms_r = max(1._wp, &
1603 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1604 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1605
1606 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1607 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1608
1609 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1610 end if
1611
1612 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1613 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1614
1615 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1616 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1617 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1618 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1619 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1620
1621 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1622 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1623 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1624
1625
1626# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1627#if defined(MFC_OpenACC)
1628# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1629!$acc loop seq
1630# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1631#elif defined(MFC_OpenMP)
1632# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1633
1634# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1635#endif
1636 do i = 1, eqn_idx%cont%end
1637 flux_rsx_vf(j, k, l, &
1638 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
1639 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1640 end do
1641
1642 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1643
1644# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1645#if defined(MFC_OpenACC)
1646# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1647!$acc loop seq
1648# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1649#elif defined(MFC_OpenMP)
1650# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1651
1652# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1653#endif
1654 do i = 1, num_dims
1655 flux_rsx_vf(j, k, l, &
1656 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
1657 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1658 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
1659 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1660 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1661 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
1662 end do
1663
1664 if (bubbles_euler) then
1665 ! Put p_tilde in
1666
1667# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1668#if defined(MFC_OpenACC)
1669# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1670!$acc loop seq
1671# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1672#elif defined(MFC_OpenMP)
1673# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1674
1675# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1676#endif
1677 do i = 1, num_dims
1678 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
1679 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
1680 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
1681 end do
1682 end if
1683
1684 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
1685
1686
1687# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1688#if defined(MFC_OpenACC)
1689# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1690!$acc loop seq
1691# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1692#elif defined(MFC_OpenMP)
1693# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1694
1695# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1696#endif
1697 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
1698 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1699 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1700 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1701 end do
1702
1703 ! Advection velocity source: interface velocity for volume fraction transport
1704
1705# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1706#if defined(MFC_OpenACC)
1707# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1708!$acc loop seq
1709# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1710#elif defined(MFC_OpenMP)
1711# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1712
1713# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1714#endif
1715 do i = 1, num_dims
1716 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
1717 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
1718 end do
1719
1720 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1721
1722 ! Add advection flux for bubble variables
1723 if (bubbles_euler) then
1724
1725# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1726#if defined(MFC_OpenACC)
1727# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1728!$acc loop seq
1729# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1730#elif defined(MFC_OpenMP)
1731# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1732
1733# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1734#endif
1735 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1736 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
1737 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1738 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
1739 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1740 end do
1741 end if
1742
1743 ! Geometrical source flux for cylindrical coordinates
1744
1745# 757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1746# 773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1747 end do
1748 end do
1749 end do
1750
1751# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1752#if defined(MFC_OpenACC)
1753# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1754!$acc end parallel loop
1755# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1756#elif defined(MFC_OpenMP)
1757# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1758
1759# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1760!$omp end target teams loop
1761# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1762#endif
1763 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
1764 ! 5-equation model with Euler-Euler bubble dynamics
1765
1766# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1767
1768# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1769#if defined(MFC_OpenACC)
1770# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1771!$acc parallel loop collapse(3) gang vector default(present) &
1772# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1773!$acc& 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) &
1774# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1775!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
1776# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1777#elif defined(MFC_OpenMP)
1778# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1779
1780# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1781
1782# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1783
1784# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1785!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1786# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1787!$omp& 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) &
1788# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1789!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
1790# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1791#endif
1792# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1793 do l = is3%beg, is3%end
1794 do k = is2%beg, is2%end
1795 do j = is1%beg, is1%end
1796 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1797 rho_l = 0._wp; rho_r = 0._wp
1798 gamma_l = 0._wp; gamma_r = 0._wp
1799 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1800 qv_l = 0._wp; qv_r = 0._wp
1801
1802
1803# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1804#if defined(MFC_OpenACC)
1805# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1806!$acc loop seq
1807# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1808#elif defined(MFC_OpenMP)
1809# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1810
1811# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1812#endif
1813 do i = 1, num_fluids
1814 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1815 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1816 end do
1817
1818 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1819
1820
1821# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1822#if defined(MFC_OpenACC)
1823# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1824!$acc loop seq
1825# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1826#elif defined(MFC_OpenMP)
1827# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1828
1829# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1830#endif
1831 do i = 1, num_dims
1832 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1833 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1834 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1835 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1836 end do
1837
1838 ! Retain this in the refactor
1839 if (mpp_lim .and. (num_fluids > 2)) then
1840
1841# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1842#if defined(MFC_OpenACC)
1843# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1844!$acc loop seq
1845# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1846#elif defined(MFC_OpenMP)
1847# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1848
1849# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1850#endif
1851 do i = 1, num_fluids
1852 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
1853 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
1854 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
1855 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
1856 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
1857 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
1858 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
1859 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
1860 end do
1861 else if (num_fluids > 2) then
1862
1863# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1864#if defined(MFC_OpenACC)
1865# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1866!$acc loop seq
1867# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1868#elif defined(MFC_OpenMP)
1869# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1870
1871# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1872#endif
1873 do i = 1, num_fluids - 1
1874 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
1875 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
1876 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
1877 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
1878 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
1879 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
1880 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
1881 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
1882 end do
1883 else
1884 rho_l = ql_prim_rsx_vf(j, k, l, 1)
1885 gamma_l = gammas(1)
1886 pi_inf_l = pi_infs(1)
1887 qv_l = qvs(1)
1888 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
1889 gamma_r = gammas(1)
1890 pi_inf_r = pi_infs(1)
1891 qv_r = qvs(1)
1892 end if
1893
1894 if (viscous) then
1895 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
1896
1897# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1898#if defined(MFC_OpenACC)
1899# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1900!$acc loop seq
1901# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1902#elif defined(MFC_OpenMP)
1903# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1904
1905# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1906#endif
1907 do i = 1, 2
1908 re_l(i) = dflt_real
1909 re_r(i) = dflt_real
1910
1911 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
1912 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
1913
1914
1915# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1916#if defined(MFC_OpenACC)
1917# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1918!$acc loop seq
1919# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1920#elif defined(MFC_OpenMP)
1921# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1922
1923# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1924#endif
1925 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
1926 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
1927 & q)))/res_gs(i, q) + re_l(i)
1928 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
1929 & q)))/res_gs(i, q) + re_r(i)
1930 end do
1931
1932 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1933 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1934 end do
1935 end if
1936 end if
1937
1938 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1939 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1940
1941 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
1942 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
1943
1944 h_l = (e_l + pres_l)/rho_l
1945 h_r = (e_r + pres_r)/rho_r
1946
1947 if (avg_state == avg_state_arithmetic) then
1948
1949# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1950#if defined(MFC_OpenACC)
1951# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1952!$acc loop seq
1953# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1954#elif defined(MFC_OpenMP)
1955# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1956
1957# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1958#endif
1959 do i = 1, nb
1960 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
1961 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
1962
1963 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
1964 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
1965 if (.not. polytropic .and. .not. qbmm) then
1966 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
1967 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
1968 end if
1969 end do
1970
1971 if (.not. qbmm) then
1972 if (adv_n) then
1973 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
1974 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
1975 else
1976 nbub_l = 0._wp
1977 nbub_r = 0._wp
1978
1979# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1980#if defined(MFC_OpenACC)
1981# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1982!$acc loop seq
1983# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1984#elif defined(MFC_OpenMP)
1985# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1986
1987# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1988#endif
1989 do i = 1, nb
1990 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
1991 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
1992 end do
1993
1994 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
1995 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
1996 & eqn_idx%E + num_fluids)/nbub_r
1997 end if
1998 else
1999 ! nb stored in 0th moment of first R0 bin in variable conversion module
2000 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
2001 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
2002 end if
2003
2004
2005# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2006#if defined(MFC_OpenACC)
2007# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2008!$acc loop seq
2009# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2010#elif defined(MFC_OpenMP)
2011# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2012
2013# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2014#endif
2015 do i = 1, nb
2016 if (.not. qbmm) then
2017 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
2018 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
2019 end if
2020 end do
2021
2022 if (qbmm) then
2023 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
2024 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
2025
2026 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
2027 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
2028
2029 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
2030 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
2031 else
2032 pbwr3lbar = 0._wp
2033 pbwr3rbar = 0._wp
2034
2035 r3lbar = 0._wp
2036 r3rbar = 0._wp
2037
2038 r3v2lbar = 0._wp
2039 r3v2rbar = 0._wp
2040
2041
2042# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2043#if defined(MFC_OpenACC)
2044# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2045!$acc loop seq
2046# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2047#elif defined(MFC_OpenMP)
2048# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2049
2050# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2051#endif
2052 do i = 1, nb
2053 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
2054 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
2055
2056 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
2057 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
2058
2059 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
2060 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
2061 end do
2062 end if
2063
2064 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2065 h_avg = 5.e-1_wp*(h_l + h_r)
2066 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2067 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2068 vel_avg_rms = 0._wp
2069
2070
2071# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2072#if defined(MFC_OpenACC)
2073# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2074!$acc loop seq
2075# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2076#elif defined(MFC_OpenMP)
2077# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2078
2079# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2080#endif
2081 do i = 1, num_dims
2082 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2083 end do
2084 end if
2085
2086 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
2087 & c_l, qv_l)
2088
2089 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
2090 & c_r, qv_r)
2091
2092 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2093 ! variables are placeholders to call the subroutine.
2094 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2095 & 0._wp, c_avg, qv_avg)
2096
2097 if (viscous) then
2098
2099# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2100#if defined(MFC_OpenACC)
2101# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2102!$acc loop seq
2103# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2104#elif defined(MFC_OpenMP)
2105# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2106
2107# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2108#endif
2109 do i = 1, 2
2110 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2111 end do
2112 end if
2113
2114 ! Low Mach correction
2115 if (low_mach == 2) then
2116 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2117# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2118 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2119# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2120 pcorr = 0._wp
2121# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2122
2123# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2124 if (low_mach == 1) then
2125# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2126 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2127# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2128 end if
2129# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2130 else if (riemann_solver == riemann_solver_hllc) then
2131# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2132 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2133# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2134 pcorr = 0._wp
2135# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2136
2137# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2138 if (low_mach == 1) then
2139# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2140 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))) &
2141# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2142 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2143# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2144 else if (low_mach == 2) then
2145# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2146 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))))
2147# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2148 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))))
2149# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2150 vel_l(dir_idx(1)) = vel_l_tmp
2151# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2152 vel_r(dir_idx(1)) = vel_r_tmp
2153# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2154 end if
2155# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2156 end if
2157 end if
2158
2159 if (wave_speeds == wave_speeds_direct) then
2160 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2161 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2162
2163 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2164 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2165 & - rho_r*(s_r - vel_r(dir_idx(1))))
2166 else if (wave_speeds == wave_speeds_pressure) then
2167 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2168
2169 pres_sr = pres_sl
2170
2171 ! Low Mach correction: Thornber et al. JCP (2008)
2172 ms_l = max(1._wp, &
2173 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2174 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2175 ms_r = max(1._wp, &
2176 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2177 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2178
2179 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2180 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2181
2182 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2183 end if
2184
2185 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2186 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2187
2188 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2189 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2190 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2191 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2192 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2193
2194 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2195 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2196 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2197
2198 ! Low Mach correction
2199 if (low_mach == 1) then
2200 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2201# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2202 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2203# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2204 pcorr = 0._wp
2205# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2206
2207# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2208 if (low_mach == 1) then
2209# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2210 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2211# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2212 end if
2213# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2214 else if (riemann_solver == riemann_solver_hllc) then
2215# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2216 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2217# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2218 pcorr = 0._wp
2219# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2220
2221# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2222 if (low_mach == 1) then
2223# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2224 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))) &
2225# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2226 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2227# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2228 else if (low_mach == 2) then
2229# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2230 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))))
2231# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2232 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))))
2233# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2234 vel_l(dir_idx(1)) = vel_l_tmp
2235# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2236 vel_r(dir_idx(1)) = vel_r_tmp
2237# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2238 end if
2239# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2240 end if
2241 else
2242 pcorr = 0._wp
2243 end if
2244
2245
2246# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2247#if defined(MFC_OpenACC)
2248# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2249!$acc loop seq
2250# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2251#elif defined(MFC_OpenMP)
2252# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2253
2254# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2255#endif
2256 do i = 1, eqn_idx%cont%end
2257 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2258 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2259 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2260 end do
2261
2262 if (bubbles_euler .and. (num_fluids > 1)) then
2263 ! Kill mass transport @ gas density
2264 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
2265 end if
2266
2267 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
2268
2269 ! Include p_tilde
2270
2271 if (avg_state == avg_state_arithmetic) then
2272 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
2273 pres_l = pres_l - alpha_l(num_fluids)*pres_l
2274 else
2275 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
2276 end if
2277
2278 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
2279 pres_r = pres_r - alpha_r(num_fluids)*pres_r
2280 else
2281 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
2282 end if
2283 end if
2284
2285
2286# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2287#if defined(MFC_OpenACC)
2288# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2289!$acc loop seq
2290# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2291#elif defined(MFC_OpenMP)
2292# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2293
2294# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2295#endif
2296 do i = 1, num_dims
2297 flux_rsx_vf(j, k, l, &
2298 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
2299 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
2300 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
2301 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2302 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
2303 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
2304 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
2305 end do
2306
2307 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
2308 flux_rsx_vf(j, k, l, &
2309 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
2310 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
2311 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
2312 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
2313 & *pcorr*s_s
2314
2315 ! Volume fraction flux
2316
2317# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2318#if defined(MFC_OpenACC)
2319# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2320!$acc loop seq
2321# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2322#elif defined(MFC_OpenMP)
2323# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2324
2325# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2326#endif
2327 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2328 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2329 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2330 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2331 end do
2332
2333 ! Advection velocity source: interface velocity for volume fraction transport
2334
2335# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2336#if defined(MFC_OpenACC)
2337# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2338!$acc loop seq
2339# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2340#elif defined(MFC_OpenMP)
2341# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2342
2343# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2344#endif
2345 do i = 1, num_dims
2346 vel_src_rsx_vf(j, k, l, &
2347 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2348 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2349
2350 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
2351 end do
2352
2353 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2354
2355 ! Add advection flux for bubble variables
2356
2357# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2358#if defined(MFC_OpenACC)
2359# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2360!$acc loop seq
2361# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2362#elif defined(MFC_OpenMP)
2363# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2364
2365# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2366#endif
2367 do i = eqn_idx%bub%beg, eqn_idx%bub%end
2368 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
2369 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2370 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2371 end do
2372
2373 if (qbmm) then
2374 flux_rsx_vf(j, k, l, &
2375 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2376 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2377 end if
2378
2379 if (adv_n) then
2380 flux_rsx_vf(j, k, l, &
2381 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2382 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2383 end if
2384
2385 ! Geometrical source flux for cylindrical coordinates
2386# 1152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2387# 1169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2388 end do
2389 end do
2390 end do
2391
2392# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2393#if defined(MFC_OpenACC)
2394# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2395!$acc end parallel loop
2396# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2397#elif defined(MFC_OpenMP)
2398# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2399
2400# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2401!$omp end target teams loop
2402# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2403#endif
2404 else
2405 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
2406
2407# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2408
2409# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2410#if defined(MFC_OpenACC)
2411# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2412!$acc parallel loop collapse(3) gang vector default(present) &
2413# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2414!$acc& 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, c_sum_Yi_Phi, flux_ene_e) &
2415# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2416!$acc& firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
2417# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2418#elif defined(MFC_OpenMP)
2419# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2420
2421# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2422
2423# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2424
2425# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2426!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2427# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2428!$omp& 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, c_sum_Yi_Phi, flux_ene_e) &
2429# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2430!$omp& firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
2431# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2432#endif
2433# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2434 do l = is3%beg, is3%end
2435 do k = is2%beg, is2%end
2436 do j = is1%beg, is1%end
2437 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2438 rho_l = 0._wp; rho_r = 0._wp
2439 gamma_l = 0._wp; gamma_r = 0._wp
2440 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2441 qv_l = 0._wp; qv_r = 0._wp
2442 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2443
2444
2445# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2446#if defined(MFC_OpenACC)
2447# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2448!$acc loop seq
2449# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2450#elif defined(MFC_OpenMP)
2451# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2452
2453# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2454#endif
2455 do i = 1, num_fluids
2456 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2457 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2458 end do
2459
2460
2461# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2462#if defined(MFC_OpenACC)
2463# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2464!$acc loop seq
2465# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2466#elif defined(MFC_OpenMP)
2467# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2468
2469# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2470#endif
2471 do i = 1, num_dims
2472 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2473 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
2474 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2475 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2476 end do
2477
2478 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2479 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
2480
2481 ! Change this by splitting it into the cases present in the bubbles_euler
2482 if (mpp_lim) then
2483
2484# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2485#if defined(MFC_OpenACC)
2486# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2487!$acc loop seq
2488# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2489#elif defined(MFC_OpenMP)
2490# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2491
2492# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2493#endif
2494 do i = 1, num_fluids
2495 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2496 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2497 & eqn_idx%E + i)), 1._wp)
2498 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
2499 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
2500 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
2501 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2502 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2503 end do
2504
2505
2506# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2507#if defined(MFC_OpenACC)
2508# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2509!$acc loop seq
2510# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2511#elif defined(MFC_OpenMP)
2512# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2513
2514# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2515#endif
2516 do i = 1, num_fluids
2517 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2518 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2519 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
2520 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2521 end do
2522 end if
2523
2524
2525# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2526#if defined(MFC_OpenACC)
2527# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2528!$acc loop seq
2529# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2530#elif defined(MFC_OpenMP)
2531# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2532
2533# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2534#endif
2535 do i = 1, num_fluids
2536 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
2537 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
2538 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
2539 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
2540
2541 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
2542 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
2543 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
2544 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
2545 end do
2546
2547 re_max = 0
2548 if (re_size_loc1 > 0) re_max = 1
2549 if (re_size_loc2 > 0) re_max = 2
2550
2551 if (viscous) then
2552
2553# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2554#if defined(MFC_OpenACC)
2555# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2556!$acc loop seq
2557# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2558#elif defined(MFC_OpenMP)
2559# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2560
2561# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2562#endif
2563 do i = 1, re_max
2564 re_l(i) = 0._wp
2565 re_r(i) = 0._wp
2566
2567
2568# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2569#if defined(MFC_OpenACC)
2570# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2571!$acc loop seq
2572# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2573#elif defined(MFC_OpenMP)
2574# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2575
2576# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2577#endif
2578 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
2579 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
2580 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
2581 end do
2582
2583 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2584 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2585 end do
2586 end if
2587
2588 if (chemistry) then
2589 c_sum_yi_phi = 0.0_wp
2590
2591# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2592#if defined(MFC_OpenACC)
2593# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2594!$acc loop seq
2595# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2596#elif defined(MFC_OpenMP)
2597# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2598
2599# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2600#endif
2601 do i = eqn_idx%species%beg, eqn_idx%species%end
2602 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2603 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
2604 end do
2605
2606 call get_mixture_molecular_weight(ys_l, mw_l)
2607 call get_mixture_molecular_weight(ys_r, mw_r)
2608
2609 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2610 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2611
2612 r_gas_l = gas_constant/mw_l
2613 r_gas_r = gas_constant/mw_r
2614
2615 t_l = pres_l/rho_l/r_gas_l
2616 t_r = pres_r/rho_r/r_gas_r
2617
2618 call get_species_specific_heats_r(t_l, cp_il)
2619 call get_species_specific_heats_r(t_r, cp_ir)
2620
2621 if (chem_params%gamma_method == 1) then
2622 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2623 gamma_il = cp_il/(cp_il - 1.0_wp)
2624 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2625
2626 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2627 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2628 else if (chem_params%gamma_method == 2) then
2629 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2630 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2631 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2632 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2633 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2634
2635 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
2636 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2637 end if
2638
2639 call get_mixture_energy_mass(t_l, ys_l, e_l)
2640 call get_mixture_energy_mass(t_r, ys_r, e_r)
2641
2642 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2643 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2644 h_l = (e_l + pres_l)/rho_l
2645 h_r = (e_r + pres_r)/rho_r
2646 else
2647 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2648 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2649
2650 h_l = (e_l + pres_l)/rho_l
2651 h_r = (e_r + pres_r)/rho_r
2652 end if
2653
2654 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
2655 if (hypoelasticity) then
2656
2657# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2658#if defined(MFC_OpenACC)
2659# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2660!$acc loop seq
2661# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2662#elif defined(MFC_OpenMP)
2663# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2664
2665# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2666#endif
2667 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2668 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2669 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2670 end do
2671 g_l = 0._wp
2672 g_r = 0._wp
2673
2674# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2675#if defined(MFC_OpenACC)
2676# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2677!$acc loop seq
2678# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2679#elif defined(MFC_OpenMP)
2680# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2681
2682# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2683#endif
2684 do i = 1, num_fluids
2685 g_l = g_l + alpha_l(i)*gs_rs(i)
2686 g_r = g_r + alpha_r(i)*gs_rs(i)
2687 end do
2688
2689# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2690#if defined(MFC_OpenACC)
2691# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2692!$acc loop seq
2693# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2694#elif defined(MFC_OpenMP)
2695# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2696
2697# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2698#endif
2699 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2700 ! Elastic contribution to energy if G large enough
2701 if ((g_l > verysmall) .and. (g_r > verysmall)) then
2702 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2703 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2704 ! Additional terms in 2D and 3D
2705 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
2706 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2707 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2708 end if
2709 end if
2710 end do
2711 end if
2712
2713 ! Hyperelastic stress contribution: strain energy added to total energy
2714 if (hyperelasticity) then
2715
2716# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2717#if defined(MFC_OpenACC)
2718# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2719!$acc loop seq
2720# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2721#elif defined(MFC_OpenMP)
2722# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2723
2724# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2725#endif
2726 do i = 1, num_dims
2727 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
2728 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
2729 end do
2730 g_l = 0._wp
2731 g_r = 0._wp
2732
2733# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2734#if defined(MFC_OpenACC)
2735# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2736!$acc loop seq
2737# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2738#elif defined(MFC_OpenMP)
2739# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2740
2741# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2742#endif
2743 do i = 1, num_fluids
2744 ! Mixture left and right shear modulus
2745 g_l = g_l + alpha_l(i)*gs_rs(i)
2746 g_r = g_r + alpha_r(i)*gs_rs(i)
2747 end do
2748 ! Elastic contribution to energy if G large enough
2749 if (g_l > verysmall .and. g_r > verysmall) then
2750 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
2751 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
2752 end if
2753
2754# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2755#if defined(MFC_OpenACC)
2756# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2757!$acc loop seq
2758# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2759#elif defined(MFC_OpenMP)
2760# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2761
2762# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2763#endif
2764 do i = 1, b_size - 1
2765 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2766 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2767 end do
2768 end if
2769
2770 h_l = (e_l + pres_l)/rho_l
2771 h_r = (e_r + pres_r)/rho_r
2772
2773 if (avg_state == avg_state_roe) then
2774# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2775 rho_avg = sqrt(rho_l*rho_r)
2776# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2777
2778# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2779 vel_avg_rms = 0._wp
2780# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2781
2782# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2783
2784# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2785#if defined(MFC_OpenACC)
2786# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2787!$acc loop seq
2788# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2789#elif defined(MFC_OpenMP)
2790# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2791
2792# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2793#endif
2794# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2795 do i = 1, num_vels
2796# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2797 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
2798# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2799 end do
2800# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2801
2802# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2803 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
2804# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2805
2806# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2807 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
2808# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2809
2810# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2811 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
2812# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2813
2814# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2815 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
2816# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2817
2818# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2819 if (chemistry) then
2820# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2821 eps = 0.001_wp
2822# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2823 call get_species_enthalpies_rt(t_l, h_il)
2824# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2825 call get_species_enthalpies_rt(t_r, h_ir)
2826# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2827 h_il = h_il*gas_constant/molecular_weights*t_l
2828# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2829 h_ir = h_ir*gas_constant/molecular_weights*t_r
2830# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2831 call get_species_specific_heats_r(t_l, cp_il)
2832# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2833 call get_species_specific_heats_r(t_r, cp_ir)
2834# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2835
2836# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2837 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2838# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2839 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2840# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2841 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2842# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2843 if (abs(t_l - t_r) < eps) then
2844# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2845 ! Case when T_L and T_R are very close
2846# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2847 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2848# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2849 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2850# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2851 & - gas_constant/molecular_weights(:)))
2852# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2853 else
2854# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2855 ! Normal calculation when T_L and T_R are sufficiently different
2856# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2857 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2858# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2859 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2860# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2861 end if
2862# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2863 gamma_avg = cp_avg/cv_avg
2864# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2865
2866# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2867 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2868# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2869 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2870# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2871 end if
2872# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2873 end if
2874# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2875
2876# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2877 if (avg_state == avg_state_arithmetic) then
2878# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2879 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2880# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2881 vel_avg_rms = 0._wp
2882# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2883
2884# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2885#if defined(MFC_OpenACC)
2886# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2887!$acc loop seq
2888# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2889#elif defined(MFC_OpenMP)
2890# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2891
2892# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2893#endif
2894# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2895 do i = 1, num_vels
2896# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2897 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2898# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2899 end do
2900# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2901
2902# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2903 h_avg = 5.e-1_wp*(h_l + h_r)
2904# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2905 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2906# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2907 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2908# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2909 end if
2910
2911 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
2912 & c_l, qv_l)
2913
2914 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
2915 & c_r, qv_r)
2916
2917 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2918 ! variables are placeholders to call the subroutine.
2919 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2920 & c_sum_yi_phi, c_avg, qv_avg)
2921
2922 if (viscous) then
2923 if (chemistry) then
2924 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2925 end if
2926
2927# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2928#if defined(MFC_OpenACC)
2929# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2930!$acc loop seq
2931# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2932#elif defined(MFC_OpenMP)
2933# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2934
2935# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2936#endif
2937 do i = 1, 2
2938 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2939 end do
2940 end if
2941
2942 ! Low Mach correction
2943 if (low_mach == 2) then
2944 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2945# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2946 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2947# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2948 pcorr = 0._wp
2949# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2950
2951# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2952 if (low_mach == 1) then
2953# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2954 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2955# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2956 end if
2957# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2958 else if (riemann_solver == riemann_solver_hllc) then
2959# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2960 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2961# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2962 pcorr = 0._wp
2963# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2964
2965# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2966 if (low_mach == 1) then
2967# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2968 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))) &
2969# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2970 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2971# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2972 else if (low_mach == 2) then
2973# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2974 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))))
2975# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2976 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))))
2977# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2978 vel_l(dir_idx(1)) = vel_l_tmp
2979# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2980 vel_r(dir_idx(1)) = vel_r_tmp
2981# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2982 end if
2983# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2984 end if
2985 end if
2986
2987 if (wave_speeds == wave_speeds_direct) then
2988 if (elasticity) then
2989 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2990 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) &
2991 & ))/rho_l), &
2992 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
2993 & + tau_e_r(dir_idx_tau(1)))/rho_r))
2994 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) &
2995 & ))/rho_r), &
2996 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
2997 & + tau_e_l(dir_idx_tau(1)))/rho_l))
2998 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
2999 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
3000 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
3001 & - vel_r(dir_idx(1))))
3002 else
3003 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3004 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3005 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3006 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
3007 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
3008 end if
3009 else if (wave_speeds == wave_speeds_pressure) then
3010 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3011
3012 pres_sr = pres_sl
3013
3014 ! Low Mach correction: Thornber et al. JCP (2008)
3015 ms_l = max(1._wp, &
3016 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3017 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3018 ms_r = max(1._wp, &
3019 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3020 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3021
3022 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3023 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3024
3025 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3026 end if
3027
3028 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3029 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3030
3031 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3032 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3033 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3034 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
3035 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3036 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3037
3038 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3039 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
3040 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
3041
3042 ! Low Mach correction
3043 if (low_mach == 1) then
3044 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3045# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3046 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3047# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3048 pcorr = 0._wp
3049# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3050
3051# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3052 if (low_mach == 1) then
3053# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3054 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3055# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3056 end if
3057# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3058 else if (riemann_solver == riemann_solver_hllc) then
3059# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3060 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3061# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3062 pcorr = 0._wp
3063# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3064
3065# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3066 if (low_mach == 1) then
3067# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3068 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))) &
3069# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3070 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3071# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3072 else if (low_mach == 2) then
3073# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3074 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))))
3075# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3076 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))))
3077# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3078 vel_l(dir_idx(1)) = vel_l_tmp
3079# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3080 vel_r(dir_idx(1)) = vel_r_tmp
3081# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3082 end if
3083# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3084 end if
3085 else
3086 pcorr = 0._wp
3087 end if
3088
3089 ! COMPUTING THE HLLC FLUXES MASS FLUX.
3090
3091# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3092#if defined(MFC_OpenACC)
3093# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3094!$acc loop seq
3095# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3096#elif defined(MFC_OpenMP)
3097# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3098
3099# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3100#endif
3101 do i = 1, eqn_idx%cont%end
3102 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3103 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3104 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3105 end do
3106
3107 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
3108 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
3109
3110# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3111#if defined(MFC_OpenACC)
3112# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3113!$acc loop seq
3114# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3115#elif defined(MFC_OpenMP)
3116# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3117
3118# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3119#endif
3120 do i = 1, num_dims
3121 flux_rsx_vf(j, k, l, &
3122 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
3123 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
3124 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
3125 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
3126 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
3127 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
3128 end do
3129
3130 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3131 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
3132 flux_rsx_vf(j, k, l, &
3133 & 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 &
3134 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
3135 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
3136 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
3137 & *(s_p/s_r)*pcorr*s_s
3138
3139 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
3140 if (elasticity) then
3141 flux_ene_e = 0._wp
3142
3143# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3144#if defined(MFC_OpenACC)
3145# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3146!$acc loop seq
3147# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3148#elif defined(MFC_OpenMP)
3149# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3150
3151# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3152#endif
3153 do i = 1, num_dims
3154 ! MOMENTUM ELASTIC FLUX.
3155 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
3156 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
3157 & - xi_p*tau_e_r(dir_idx_tau(i))
3158 ! ENERGY ELASTIC FLUX.
3159 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
3160 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
3161 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
3162 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
3163 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
3164 end do
3165 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
3166 end if
3167
3168 ! HYPOELASTIC STRESS EVOLUTION FLUX.
3169 if (hypoelasticity) then
3170
3171# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3172#if defined(MFC_OpenACC)
3173# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3174!$acc loop seq
3175# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3176#elif defined(MFC_OpenMP)
3177# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3178
3179# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3180#endif
3181 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
3182 flux_rsx_vf(j, k, l, &
3183 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
3184 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
3185 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
3186 end do
3187 end if
3188
3189 ! VOLUME FRACTION FLUX.
3190
3191# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3192#if defined(MFC_OpenACC)
3193# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3194!$acc loop seq
3195# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3196#elif defined(MFC_OpenMP)
3197# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3198
3199# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3200#endif
3201 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3202 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3203 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
3204 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3205 end do
3206
3207 ! VOLUME FRACTION SOURCE FLUX.
3208
3209# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3210#if defined(MFC_OpenACC)
3211# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3212!$acc loop seq
3213# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3214#elif defined(MFC_OpenMP)
3215# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3216
3217# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3218#endif
3219 do i = 1, num_dims
3220 vel_src_rsx_vf(j, k, l, &
3221 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
3222 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
3223 end do
3224
3225 ! COLOR FUNCTION FLUX
3226 if (surface_tension) then
3227 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
3228 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3229 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3230 end if
3231
3232 ! Hyperelastic reference map flux for material deformation tracking
3233 if (hyperelasticity) then
3234
3235# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3236#if defined(MFC_OpenACC)
3237# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3238!$acc loop seq
3239# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3240#elif defined(MFC_OpenMP)
3241# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3242
3243# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3244#endif
3245 do i = 1, num_dims
3246 flux_rsx_vf(j, k, l, &
3247 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
3248 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
3249 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
3250 end do
3251 end if
3252
3253 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3254
3255 if (chemistry) then
3256
3257# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3258#if defined(MFC_OpenACC)
3259# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3260!$acc loop seq
3261# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3262#elif defined(MFC_OpenMP)
3263# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3264
3265# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3266#endif
3267 do i = eqn_idx%species%beg, eqn_idx%species%end
3268 y_l = ql_prim_rsx_vf(j, k, l, i)
3269 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
3270
3271 flux_rsx_vf(j, k, l, &
3272 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
3273 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3274 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
3275 end do
3276 end if
3277
3278 ! Geometrical source flux for cylindrical coordinates
3279# 1605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3280# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3281 end do
3282 end do
3283 end do
3284
3285# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3286#if defined(MFC_OpenACC)
3287# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3288!$acc end parallel loop
3289# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3290#elif defined(MFC_OpenMP)
3291# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3292
3293# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3294!$omp end target teams loop
3295# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3296#endif
3297 end if
3298 end if
3299# 136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3300# 137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3301# 138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3302 if (norm_dir == 2) then
3303 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
3304 if (model_eqns == model_eqns_6eq) then
3305 ! 6-equation model (model_eqns=3): separate phasic internal energies
3306
3307# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3308
3309# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3310#if defined(MFC_OpenACC)
3311# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3312!$acc parallel loop collapse(3) gang vector default(present) &
3313# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3314!$acc& 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) &
3315# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3316!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
3317# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3318#elif defined(MFC_OpenMP)
3319# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3320
3321# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3322
3323# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3324
3325# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3326!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3327# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3328!$omp& 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) &
3329# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3330!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
3331# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3332#endif
3333# 152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3334 do l = is3%beg, is3%end
3335 do k = is1%beg, is1%end
3336 do j = is2%beg, is2%end
3337 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3338 rho_l = 0._wp; rho_r = 0._wp
3339 gamma_l = 0._wp; gamma_r = 0._wp
3340 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3341 qv_l = 0._wp; qv_r = 0._wp
3342 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
3343
3344
3345# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3346#if defined(MFC_OpenACC)
3347# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3348!$acc loop seq
3349# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3350#elif defined(MFC_OpenMP)
3351# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3352
3353# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3354#endif
3355 do i = 1, num_dims
3356 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3357 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3358 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3359 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3360 end do
3361
3362 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3363 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3364
3365 rho_l = 0._wp
3366 gamma_l = 0._wp
3367 pi_inf_l = 0._wp
3368 qv_l = 0._wp
3369
3370 rho_r = 0._wp
3371 gamma_r = 0._wp
3372 pi_inf_r = 0._wp
3373 qv_r = 0._wp
3374
3375 alpha_l_sum = 0._wp
3376 alpha_r_sum = 0._wp
3377
3378 if (mpp_lim) then
3379
3380# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3381#if defined(MFC_OpenACC)
3382# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3383!$acc loop seq
3384# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3385#elif defined(MFC_OpenMP)
3386# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3387
3388# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3389#endif
3390 do i = 1, num_fluids
3391 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
3392 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
3393 & eqn_idx%E + i)), 1._wp)
3394 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3395 end do
3396
3397
3398# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3399#if defined(MFC_OpenACC)
3400# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3401!$acc loop seq
3402# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3403#elif defined(MFC_OpenMP)
3404# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3405
3406# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3407#endif
3408 do i = 1, num_fluids
3409 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
3410 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
3411 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
3412 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3413 end do
3414
3415
3416# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3417#if defined(MFC_OpenACC)
3418# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3419!$acc loop seq
3420# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3421#elif defined(MFC_OpenMP)
3422# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3423
3424# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3425#endif
3426 do i = 1, num_fluids
3427 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
3428 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
3429 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
3430 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
3431 end do
3432 end if
3433
3434
3435# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3436#if defined(MFC_OpenACC)
3437# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3438!$acc loop seq
3439# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3440#elif defined(MFC_OpenMP)
3441# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3442
3443# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3444#endif
3445 do i = 1, num_fluids
3446 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
3447 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
3448 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
3449 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
3450
3451 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
3452 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
3453 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
3454 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
3455
3456 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
3457 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
3458 end do
3459
3460 if (viscous) then
3461
3462# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3463#if defined(MFC_OpenACC)
3464# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3465!$acc loop seq
3466# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3467#elif defined(MFC_OpenMP)
3468# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3469
3470# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3471#endif
3472 do i = 1, 2
3473 re_l(i) = dflt_real
3474 re_r(i) = dflt_real
3475 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
3476 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
3477
3478# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3479#if defined(MFC_OpenACC)
3480# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3481!$acc loop seq
3482# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3483#elif defined(MFC_OpenMP)
3484# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3485
3486# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3487#endif
3488 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
3489 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
3490 re_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
3491 & q) + re_r(i)
3492 end do
3493 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3494 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3495 end do
3496 end if
3497
3498 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
3499 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
3500
3501 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
3502 if (hypoelasticity) then
3503
3504# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3505#if defined(MFC_OpenACC)
3506# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3507!$acc loop seq
3508# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3509#elif defined(MFC_OpenMP)
3510# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3511
3512# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3513#endif
3514 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
3515 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
3516 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
3517 end do
3518 g_l = 0._wp; g_r = 0._wp
3519
3520# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3521#if defined(MFC_OpenACC)
3522# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3523!$acc loop seq
3524# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3525#elif defined(MFC_OpenMP)
3526# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3527
3528# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3529#endif
3530 do i = 1, num_fluids
3531 g_l = g_l + alpha_l(i)*gs_rs(i)
3532 g_r = g_r + alpha_r(i)*gs_rs(i)
3533 end do
3534
3535# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3536#if defined(MFC_OpenACC)
3537# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3538!$acc loop seq
3539# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3540#elif defined(MFC_OpenMP)
3541# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3542
3543# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3544#endif
3545 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
3546 ! Elastic contribution to energy if G large enough
3547 if ((g_l > verysmall) .and. (g_r > verysmall)) then
3548 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3549 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3550 ! Additional terms in 2D and 3D
3551 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
3552 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3553 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3554 end if
3555 end if
3556 end do
3557 end if
3558
3559 ! Hyperelastic stress contribution: strain energy added to total energy
3560 if (hyperelasticity) then
3561
3562# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3563#if defined(MFC_OpenACC)
3564# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3565!$acc loop seq
3566# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3567#elif defined(MFC_OpenMP)
3568# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3569
3570# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3571#endif
3572 do i = 1, num_dims
3573 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
3574 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
3575 end do
3576 g_l = 0._wp; g_r = 0._wp
3577
3578# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3579#if defined(MFC_OpenACC)
3580# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3581!$acc loop seq
3582# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3583#elif defined(MFC_OpenMP)
3584# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3585
3586# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3587#endif
3588 do i = 1, num_fluids
3589 ! Mixture left and right shear modulus
3590 g_l = g_l + alpha_l(i)*gs_rs(i)
3591 g_r = g_r + alpha_r(i)*gs_rs(i)
3592 end do
3593 ! Elastic contribution to energy if G large enough
3594 if (g_l > verysmall .and. g_r > verysmall) then
3595 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
3596 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
3597 end if
3598
3599# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3600#if defined(MFC_OpenACC)
3601# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3602!$acc loop seq
3603# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3604#elif defined(MFC_OpenMP)
3605# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3606
3607# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3608#endif
3609 do i = 1, b_size - 1
3610 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
3611 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
3612 end do
3613 end if
3614
3615 h_l = (e_l + pres_l)/rho_l
3616 h_r = (e_r + pres_r)/rho_r
3617
3618 if (avg_state == avg_state_roe) then
3619# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3620 rho_avg = sqrt(rho_l*rho_r)
3621# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3622
3623# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3624 vel_avg_rms = 0._wp
3625# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3626
3627# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3628
3629# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3630#if defined(MFC_OpenACC)
3631# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3632!$acc loop seq
3633# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3634#elif defined(MFC_OpenMP)
3635# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3636
3637# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3638#endif
3639# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3640 do i = 1, num_vels
3641# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3642 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
3643# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3644 end do
3645# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3646
3647# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3648 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3649# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3650
3651# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3652 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3653# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3654
3655# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3656 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
3657# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3658
3659# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3660 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3661# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3662
3663# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3664 if (chemistry) then
3665# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3666 eps = 0.001_wp
3667# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3668 call get_species_enthalpies_rt(t_l, h_il)
3669# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3670 call get_species_enthalpies_rt(t_r, h_ir)
3671# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3672 h_il = h_il*gas_constant/molecular_weights*t_l
3673# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3674 h_ir = h_ir*gas_constant/molecular_weights*t_r
3675# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3676 call get_species_specific_heats_r(t_l, cp_il)
3677# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3678 call get_species_specific_heats_r(t_r, cp_ir)
3679# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3680
3681# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3682 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3683# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3684 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3685# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3686 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3687# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3688 if (abs(t_l - t_r) < eps) then
3689# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3690 ! Case when T_L and T_R are very close
3691# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3692 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3693# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3694 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3695# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3696 & - gas_constant/molecular_weights(:)))
3697# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3698 else
3699# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3700 ! Normal calculation when T_L and T_R are sufficiently different
3701# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3702 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3703# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3704 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3705# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3706 end if
3707# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3708 gamma_avg = cp_avg/cv_avg
3709# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3710
3711# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3712 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3713# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3714 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3715# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3716 end if
3717# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3718 end if
3719# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3720
3721# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3722 if (avg_state == avg_state_arithmetic) then
3723# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3724 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3725# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3726 vel_avg_rms = 0._wp
3727# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3728
3729# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3730#if defined(MFC_OpenACC)
3731# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3732!$acc loop seq
3733# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3734#elif defined(MFC_OpenMP)
3735# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3736
3737# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3738#endif
3739# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3740 do i = 1, num_vels
3741# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3742 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3743# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3744 end do
3745# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3746
3747# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3748 h_avg = 5.e-1_wp*(h_l + h_r)
3749# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3750 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3751# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3752 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3753# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3754 end if
3755
3756 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
3757 & c_l, qv_l)
3758
3759 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
3760 & c_r, qv_r)
3761
3762 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3763 ! variables are placeholders to call the subroutine.
3764 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3765 & 0._wp, c_avg, qv_avg)
3766
3767 if (viscous) then
3768
3769# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3770#if defined(MFC_OpenACC)
3771# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3772!$acc loop seq
3773# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3774#elif defined(MFC_OpenMP)
3775# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3776
3777# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3778#endif
3779 do i = 1, 2
3780 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3781 end do
3782 end if
3783
3784 ! Low Mach correction
3785 if (low_mach == 2) then
3786 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3787# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3788 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3789# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3790 pcorr = 0._wp
3791# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3792
3793# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3794 if (low_mach == 1) then
3795# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3796 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3797# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3798 end if
3799# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3800 else if (riemann_solver == riemann_solver_hllc) then
3801# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3802 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3803# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3804 pcorr = 0._wp
3805# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3806
3807# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3808 if (low_mach == 1) then
3809# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3810 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))) &
3811# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3812 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3813# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3814 else if (low_mach == 2) then
3815# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3816 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))))
3817# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3818 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))))
3819# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3820 vel_l(dir_idx(1)) = vel_l_tmp
3821# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3822 vel_r(dir_idx(1)) = vel_r_tmp
3823# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3824 end if
3825# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3826 end if
3827 end if
3828
3829 ! COMPUTING THE DIRECT WAVE SPEEDS
3830 if (wave_speeds == wave_speeds_direct) then
3831 if (elasticity) then
3832 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3833 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) &
3834 & ))/rho_l), &
3835 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
3836 & + tau_e_r(dir_idx_tau(1)))/rho_r))
3837 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) &
3838 & ))/rho_r), &
3839 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
3840 & + tau_e_l(dir_idx_tau(1)))/rho_l))
3841 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
3842 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
3843 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
3844 & - vel_r(dir_idx(1))))
3845 else
3846 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3847 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3848 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3849 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
3850 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
3851 end if
3852 else if (wave_speeds == wave_speeds_pressure) then
3853 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3854
3855 pres_sr = pres_sl
3856
3857 ! Low Mach correction: Thornber et al. JCP (2008)
3858 ms_l = max(1._wp, &
3859 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3860 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3861 ms_r = max(1._wp, &
3862 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3863 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3864
3865 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3866 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3867
3868 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3869 end if
3870
3871 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3872 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3873
3874 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3875 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3876 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3877 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3878 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3879
3880 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3881 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
3882 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
3883
3884 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
3885 xi_mp = -min(0._wp, sign(1._wp, s_l))
3886 xi_pp = max(0._wp, sign(1._wp, s_r))
3887
3888 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 &
3889 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
3890 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
3891 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
3892 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
3893
3894 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))
3895
3896 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 &
3897 & - vel_r(dir_idx(1)))
3898
3899 ! Low Mach correction
3900 if (low_mach == 1) then
3901 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3902# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3903 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3904# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3905 pcorr = 0._wp
3906# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3907
3908# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3909 if (low_mach == 1) then
3910# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3911 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3912# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3913 end if
3914# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3915 else if (riemann_solver == riemann_solver_hllc) then
3916# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3917 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3918# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3919 pcorr = 0._wp
3920# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3921
3922# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3923 if (low_mach == 1) then
3924# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3925 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))) &
3926# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3927 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3928# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3929 else if (low_mach == 2) then
3930# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3931 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))))
3932# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3933 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))))
3934# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3935 vel_l(dir_idx(1)) = vel_l_tmp
3936# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3937 vel_r(dir_idx(1)) = vel_r_tmp
3938# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3939 end if
3940# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3941 end if
3942 else
3943 pcorr = 0._wp
3944 end if
3945
3946 ! COMPUTING FLUXES MASS FLUX.
3947
3948# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3949#if defined(MFC_OpenACC)
3950# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3951!$acc loop seq
3952# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3953#elif defined(MFC_OpenMP)
3954# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3955
3956# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3957#endif
3958 do i = 1, eqn_idx%cont%end
3959 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3960 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3961 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3962 end do
3963
3964 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
3965
3966# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3967#if defined(MFC_OpenACC)
3968# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3969!$acc loop seq
3970# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3971#elif defined(MFC_OpenMP)
3972# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3973
3974# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3975#endif
3976 do i = 1, num_dims
3977 flux_rsx_vf(j, k, l, &
3978 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
3979 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
3980 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
3981 & *dir_flg(dir_idx(i))*pcorr
3982 end do
3983
3984 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3985 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
3986
3987 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
3988 if (elasticity) then
3989 flux_ene_e = 0._wp
3990
3991# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3992#if defined(MFC_OpenACC)
3993# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3994!$acc loop seq
3995# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3996#elif defined(MFC_OpenMP)
3997# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3998
3999# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4000#endif
4001 do i = 1, num_dims
4002 ! MOMENTUM ELASTIC FLUX.
4003 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
4004 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
4005 & - xi_p*tau_e_r(dir_idx_tau(i))
4006 ! ENERGY ELASTIC FLUX.
4007 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
4008 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
4009 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
4010 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
4011 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
4012 end do
4013 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
4014 end if
4015
4016 ! VOLUME FRACTION FLUX.
4017
4018# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4019#if defined(MFC_OpenACC)
4020# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4021!$acc loop seq
4022# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4023#elif defined(MFC_OpenMP)
4024# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4025
4026# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4027#endif
4028 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4029 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4030 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
4031 end do
4032
4033 ! Advection velocity source: interface velocity for volume fraction transport
4034
4035# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4036#if defined(MFC_OpenACC)
4037# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4038!$acc loop seq
4039# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4040#elif defined(MFC_OpenMP)
4041# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4042
4043# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4044#endif
4045 do i = 1, num_dims
4046 vel_src_rsx_vf(j, k, l, &
4047 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4048 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
4049 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
4050 end do
4051
4052 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
4053 ! energy flux
4054
4055# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4056#if defined(MFC_OpenACC)
4057# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4058!$acc loop seq
4059# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4060#elif defined(MFC_OpenMP)
4061# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4062
4063# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4064#endif
4065 do i = 1, num_fluids
4066 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
4067 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
4068 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
4069 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
4070 & + pres_r)
4071
4072 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
4073 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4074 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
4075 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
4076 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4077 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
4078 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
4079 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4080 & i + eqn_idx%adv%beg - 1))
4081 end do
4082
4083 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4084
4085 ! HYPOELASTIC STRESS EVOLUTION FLUX.
4086 if (hypoelasticity) then
4087
4088# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4089#if defined(MFC_OpenACC)
4090# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4091!$acc loop seq
4092# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4093#elif defined(MFC_OpenMP)
4094# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4095
4096# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4097#endif
4098 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4099 flux_rsx_vf(j, k, l, &
4100 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
4101 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
4102 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
4103 end do
4104 end if
4105
4106 ! Hyperelastic reference map flux for material deformation tracking
4107 if (hyperelasticity) then
4108
4109# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4110#if defined(MFC_OpenACC)
4111# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4112!$acc loop seq
4113# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4114#elif defined(MFC_OpenMP)
4115# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4116
4117# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4118#endif
4119 do i = 1, num_dims
4120 flux_rsx_vf(j, k, l, &
4121 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
4122 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
4123 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
4124 end do
4125 end if
4126
4127 ! COLOR FUNCTION FLUX
4128 if (surface_tension) then
4129 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
4130 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
4131 end if
4132
4133 ! Geometrical source flux for cylindrical coordinates
4134# 517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4135 if (cyl_coord) then
4136 ! Substituting the advective flux into the inviscid geometrical source flux
4137
4138# 519 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4139#if defined(MFC_OpenACC)
4140# 519 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4141!$acc loop seq
4142# 519 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4143#elif defined(MFC_OpenMP)
4144# 519 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4145
4146# 519 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4147#endif
4148 do i = 1, eqn_idx%E
4149 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4150 end do
4151
4152# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4153#if defined(MFC_OpenACC)
4154# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4155!$acc loop seq
4156# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4157#elif defined(MFC_OpenMP)
4158# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4159
4160# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4161#endif
4162 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
4163 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4164 end do
4165 ! Recalculating the radial momentum geometric source flux
4166 flux_gsrc_rsx_vf(j, k, l, &
4167 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
4168 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
4169 ! Geometrical source of the void fraction(s) is zero
4170
4171# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4172#if defined(MFC_OpenACC)
4173# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4174!$acc loop seq
4175# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4176#elif defined(MFC_OpenMP)
4177# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4178
4179# 532 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4180#endif
4181 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4182 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4183 end do
4184 end if
4185# 538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4186# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4187 end do
4188 end do
4189 end do
4190
4191# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4192#if defined(MFC_OpenACC)
4193# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4194!$acc end parallel loop
4195# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4196#elif defined(MFC_OpenMP)
4197# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4198
4199# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4200!$omp end target teams loop
4201# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4202#endif
4203 else if (model_eqns == model_eqns_4eq) then
4204 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
4205
4206# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4207
4208# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4209#if defined(MFC_OpenACC)
4210# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4211!$acc parallel loop collapse(3) gang vector default(present) &
4212# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4213!$acc& 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)
4214# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4215#elif defined(MFC_OpenMP)
4216# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4217
4218# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4219
4220# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4221
4222# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4223!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4224# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4225!$omp& 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)
4226# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4227#endif
4228# 566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4229 do l = is3%beg, is3%end
4230 do k = is1%beg, is1%end
4231 do j = is2%beg, is2%end
4232 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4233 rho_l = 0._wp; rho_r = 0._wp
4234 gamma_l = 0._wp; gamma_r = 0._wp
4235 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4236 qv_l = 0._wp; qv_r = 0._wp
4237
4238
4239# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4240#if defined(MFC_OpenACC)
4241# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4242!$acc loop seq
4243# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4244#elif defined(MFC_OpenMP)
4245# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4246
4247# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4248#endif
4249 do i = 1, eqn_idx%cont%end
4250 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4251 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4252 end do
4253
4254
4255# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4256#if defined(MFC_OpenACC)
4257# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4258!$acc loop seq
4259# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4260#elif defined(MFC_OpenMP)
4261# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4262
4263# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4264#endif
4265 do i = 1, num_dims
4266 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4267 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4268 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4269 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4270 end do
4271
4272
4273# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4274#if defined(MFC_OpenACC)
4275# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4276!$acc loop seq
4277# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4278#elif defined(MFC_OpenMP)
4279# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4280
4281# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4282#endif
4283 do i = 1, num_fluids
4284 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4285 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4286 end do
4287
4288# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4289#if defined(MFC_OpenACC)
4290# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4291!$acc loop seq
4292# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4293#elif defined(MFC_OpenMP)
4294# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4295
4296# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4297#endif
4298 do i = 1, num_fluids
4299 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4300 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4301 end do
4302
4303
4304# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4305#if defined(MFC_OpenACC)
4306# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4307!$acc loop seq
4308# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4309#elif defined(MFC_OpenMP)
4310# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4311
4312# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4313#endif
4314 do i = 1, num_fluids
4315 rho_l = rho_l + alpha_rho_l(i)
4316 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4317 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4318 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4319
4320 rho_r = rho_r + alpha_rho_r(i)
4321 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4322 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4323 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4324 end do
4325
4326 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4327 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4328
4329 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
4330 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
4331
4332 h_l = (e_l + pres_l)/rho_l
4333 h_r = (e_r + pres_r)/rho_r
4334
4335 if (avg_state == avg_state_roe) then
4336# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4337 rho_avg = sqrt(rho_l*rho_r)
4338# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4339
4340# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4341 vel_avg_rms = 0._wp
4342# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4343
4344# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4345
4346# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4347#if defined(MFC_OpenACC)
4348# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4349!$acc loop seq
4350# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4351#elif defined(MFC_OpenMP)
4352# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4353
4354# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4355#endif
4356# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4357 do i = 1, num_vels
4358# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4359 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
4360# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4361 end do
4362# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4363
4364# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4365 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
4366# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4367
4368# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4369 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
4370# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4371
4372# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4373 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
4374# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4375
4376# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4377 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
4378# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4379
4380# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4381 if (chemistry) then
4382# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4383 eps = 0.001_wp
4384# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4385 call get_species_enthalpies_rt(t_l, h_il)
4386# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4387 call get_species_enthalpies_rt(t_r, h_ir)
4388# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4389 h_il = h_il*gas_constant/molecular_weights*t_l
4390# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4391 h_ir = h_ir*gas_constant/molecular_weights*t_r
4392# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4393 call get_species_specific_heats_r(t_l, cp_il)
4394# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4395 call get_species_specific_heats_r(t_r, cp_ir)
4396# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4397
4398# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4399 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
4400# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4401 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
4402# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4403 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
4404# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4405 if (abs(t_l - t_r) < eps) then
4406# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4407 ! Case when T_L and T_R are very close
4408# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4409 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
4410# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4411 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
4412# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4413 & - gas_constant/molecular_weights(:)))
4414# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4415 else
4416# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4417 ! Normal calculation when T_L and T_R are sufficiently different
4418# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4419 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
4420# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4421 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
4422# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4423 end if
4424# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4425 gamma_avg = cp_avg/cv_avg
4426# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4427
4428# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4429 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
4430# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4431 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
4432# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4433 end if
4434# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4435 end if
4436# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4437
4438# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4439 if (avg_state == avg_state_arithmetic) then
4440# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4441 rho_avg = 5.e-1_wp*(rho_l + rho_r)
4442# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4443 vel_avg_rms = 0._wp
4444# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4445
4446# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4447#if defined(MFC_OpenACC)
4448# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4449!$acc loop seq
4450# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4451#elif defined(MFC_OpenMP)
4452# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4453
4454# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4455#endif
4456# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4457 do i = 1, num_vels
4458# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4459 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
4460# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4461 end do
4462# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4463
4464# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4465 h_avg = 5.e-1_wp*(h_l + h_r)
4466# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4467 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
4468# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4469 qv_avg = 5.e-1_wp*(qv_l + qv_r)
4470# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4471 end if
4472
4473 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
4474 & c_l, qv_l)
4475
4476 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
4477 & c_r, qv_r)
4478
4479 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
4480 ! variables are placeholders to call the subroutine.
4481
4482 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
4483 & 0._wp, c_avg, qv_avg)
4484
4485 if (wave_speeds == wave_speeds_direct) then
4486 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
4487 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
4488
4489 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
4490 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
4491 & - rho_r*(s_r - vel_r(dir_idx(1))))
4492 else if (wave_speeds == wave_speeds_pressure) then
4493 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4494
4495 pres_sr = pres_sl
4496
4497 ! Low Mach correction: Thornber et al. JCP (2008)
4498 ms_l = max(1._wp, &
4499 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
4500 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
4501 ms_r = max(1._wp, &
4502 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
4503 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
4504
4505 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4506 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4507
4508 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4509 end if
4510
4511 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4512 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4513
4514 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4515 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4516 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4517 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4518 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4519
4520 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4521 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4522 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4523
4524
4525# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4526#if defined(MFC_OpenACC)
4527# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4528!$acc loop seq
4529# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4530#elif defined(MFC_OpenMP)
4531# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4532
4533# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4534#endif
4535 do i = 1, eqn_idx%cont%end
4536 flux_rsx_vf(j, k, l, &
4537 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
4538 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4539 end do
4540
4541 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4542
4543# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4544#if defined(MFC_OpenACC)
4545# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4546!$acc loop seq
4547# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4548#elif defined(MFC_OpenMP)
4549# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4550
4551# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4552#endif
4553 do i = 1, num_dims
4554 flux_rsx_vf(j, k, l, &
4555 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
4556 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4557 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
4558 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4559 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4560 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
4561 end do
4562
4563 if (bubbles_euler) then
4564 ! Put p_tilde in
4565
4566# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4567#if defined(MFC_OpenACC)
4568# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4569!$acc loop seq
4570# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4571#elif defined(MFC_OpenMP)
4572# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4573
4574# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4575#endif
4576 do i = 1, num_dims
4577 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
4578 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
4579 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
4580 end do
4581 end if
4582
4583 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
4584
4585
4586# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4587#if defined(MFC_OpenACC)
4588# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4589!$acc loop seq
4590# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4591#elif defined(MFC_OpenMP)
4592# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4593
4594# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4595#endif
4596 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
4597 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4598 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4599 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4600 end do
4601
4602 ! Advection velocity source: interface velocity for volume fraction transport
4603
4604# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4605#if defined(MFC_OpenACC)
4606# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4607!$acc loop seq
4608# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4609#elif defined(MFC_OpenMP)
4610# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4611
4612# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4613#endif
4614 do i = 1, num_dims
4615 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
4616 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
4617 end do
4618
4619 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4620
4621 ! Add advection flux for bubble variables
4622 if (bubbles_euler) then
4623
4624# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4625#if defined(MFC_OpenACC)
4626# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4627!$acc loop seq
4628# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4629#elif defined(MFC_OpenMP)
4630# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4631
4632# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4633#endif
4634 do i = eqn_idx%bub%beg, eqn_idx%bub%end
4635 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
4636 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4637 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, &
4638 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4639 end do
4640 end if
4641
4642 ! Geometrical source flux for cylindrical coordinates
4643
4644# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4645 if (cyl_coord) then
4646 ! Substituting the advective flux into the inviscid geometrical source flux
4647
4648# 738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4649#if defined(MFC_OpenACC)
4650# 738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4651!$acc loop seq
4652# 738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4653#elif defined(MFC_OpenMP)
4654# 738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4655
4656# 738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4657#endif
4658 do i = 1, eqn_idx%E
4659 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4660 end do
4661 ! Recalculating the radial momentum geometric source flux
4662 flux_gsrc_rsx_vf(j, k, l, &
4663 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
4664 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
4665 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
4666 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
4667 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
4668 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
4669 ! Geometrical source of the void fraction(s) is zero
4670
4671# 751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4672#if defined(MFC_OpenACC)
4673# 751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4674!$acc loop seq
4675# 751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4676#elif defined(MFC_OpenMP)
4677# 751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4678
4679# 751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4680#endif
4681 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4682 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4683 end do
4684 end if
4685# 757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4686# 773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4687 end do
4688 end do
4689 end do
4690
4691# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4692#if defined(MFC_OpenACC)
4693# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4694!$acc end parallel loop
4695# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4696#elif defined(MFC_OpenMP)
4697# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4698
4699# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4700!$omp end target teams loop
4701# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4702#endif
4703 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
4704 ! 5-equation model with Euler-Euler bubble dynamics
4705
4706# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4707
4708# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4709#if defined(MFC_OpenACC)
4710# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4711!$acc parallel loop collapse(3) gang vector default(present) &
4712# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4713!$acc& 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) &
4714# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4715!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
4716# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4717#elif defined(MFC_OpenMP)
4718# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4719
4720# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4721
4722# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4723
4724# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4725!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4726# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4727!$omp& 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) &
4728# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4729!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
4730# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4731#endif
4732# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4733 do l = is3%beg, is3%end
4734 do k = is1%beg, is1%end
4735 do j = is2%beg, is2%end
4736 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4737 rho_l = 0._wp; rho_r = 0._wp
4738 gamma_l = 0._wp; gamma_r = 0._wp
4739 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4740 qv_l = 0._wp; qv_r = 0._wp
4741
4742
4743# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4744#if defined(MFC_OpenACC)
4745# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4746!$acc loop seq
4747# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4748#elif defined(MFC_OpenMP)
4749# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4750
4751# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4752#endif
4753 do i = 1, num_fluids
4754 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4755 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4756 end do
4757
4758 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4759
4760
4761# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4762#if defined(MFC_OpenACC)
4763# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4764!$acc loop seq
4765# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4766#elif defined(MFC_OpenMP)
4767# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4768
4769# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4770#endif
4771 do i = 1, num_dims
4772 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4773 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4774 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4775 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4776 end do
4777
4778 ! Retain this in the refactor
4779 if (mpp_lim .and. (num_fluids > 2)) then
4780
4781# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4782#if defined(MFC_OpenACC)
4783# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4784!$acc loop seq
4785# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4786#elif defined(MFC_OpenMP)
4787# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4788
4789# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4790#endif
4791 do i = 1, num_fluids
4792 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
4793 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
4794 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
4795 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
4796 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
4797 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
4798 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
4799 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
4800 end do
4801 else if (num_fluids > 2) then
4802
4803# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4804#if defined(MFC_OpenACC)
4805# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4806!$acc loop seq
4807# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4808#elif defined(MFC_OpenMP)
4809# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4810
4811# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4812#endif
4813 do i = 1, num_fluids - 1
4814 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
4815 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
4816 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
4817 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
4818 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
4819 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
4820 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
4821 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
4822 end do
4823 else
4824 rho_l = ql_prim_rsx_vf(j, k, l, 1)
4825 gamma_l = gammas(1)
4826 pi_inf_l = pi_infs(1)
4827 qv_l = qvs(1)
4828 rho_r = qr_prim_rsx_vf(j, k + 1, l, 1)
4829 gamma_r = gammas(1)
4830 pi_inf_r = pi_infs(1)
4831 qv_r = qvs(1)
4832 end if
4833
4834 if (viscous) then
4835 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
4836
4837# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4838#if defined(MFC_OpenACC)
4839# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4840!$acc loop seq
4841# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4842#elif defined(MFC_OpenMP)
4843# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4844
4845# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4846#endif
4847 do i = 1, 2
4848 re_l(i) = dflt_real
4849 re_r(i) = dflt_real
4850
4851 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
4852 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
4853
4854
4855# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4856#if defined(MFC_OpenACC)
4857# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4858!$acc loop seq
4859# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4860#elif defined(MFC_OpenMP)
4861# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4862
4863# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4864#endif
4865 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
4866 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
4867 & q)))/res_gs(i, q) + re_l(i)
4868 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
4869 & q)))/res_gs(i, q) + re_r(i)
4870 end do
4871
4872 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4873 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4874 end do
4875 end if
4876 end if
4877
4878 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4879 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4880
4881 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
4882 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
4883
4884 h_l = (e_l + pres_l)/rho_l
4885 h_r = (e_r + pres_r)/rho_r
4886
4887 if (avg_state == avg_state_arithmetic) then
4888
4889# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4890#if defined(MFC_OpenACC)
4891# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4892!$acc loop seq
4893# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4894#elif defined(MFC_OpenMP)
4895# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4896
4897# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4898#endif
4899 do i = 1, nb
4900 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
4901 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
4902
4903 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
4904 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
4905 if (.not. polytropic .and. .not. qbmm) then
4906 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
4907 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
4908 end if
4909 end do
4910
4911 if (.not. qbmm) then
4912 if (adv_n) then
4913 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
4914 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
4915 else
4916 nbub_l = 0._wp
4917 nbub_r = 0._wp
4918
4919# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4920#if defined(MFC_OpenACC)
4921# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4922!$acc loop seq
4923# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4924#elif defined(MFC_OpenMP)
4925# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4926
4927# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4928#endif
4929 do i = 1, nb
4930 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
4931 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
4932 end do
4933
4934 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
4935 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
4936 & eqn_idx%E + num_fluids)/nbub_r
4937 end if
4938 else
4939 ! nb stored in 0th moment of first R0 bin in variable conversion module
4940 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
4941 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
4942 end if
4943
4944
4945# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4946#if defined(MFC_OpenACC)
4947# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4948!$acc loop seq
4949# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4950#elif defined(MFC_OpenMP)
4951# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4952
4953# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4954#endif
4955 do i = 1, nb
4956 if (.not. qbmm) then
4957 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
4958 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
4959 end if
4960 end do
4961
4962 if (qbmm) then
4963 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
4964 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
4965
4966 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
4967 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
4968
4969 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
4970 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
4971 else
4972 pbwr3lbar = 0._wp
4973 pbwr3rbar = 0._wp
4974
4975 r3lbar = 0._wp
4976 r3rbar = 0._wp
4977
4978 r3v2lbar = 0._wp
4979 r3v2rbar = 0._wp
4980
4981
4982# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4983#if defined(MFC_OpenACC)
4984# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4985!$acc loop seq
4986# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4987#elif defined(MFC_OpenMP)
4988# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4989
4990# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4991#endif
4992 do i = 1, nb
4993 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
4994 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
4995
4996 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
4997 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
4998
4999 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
5000 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
5001 end do
5002 end if
5003
5004 rho_avg = 5.e-1_wp*(rho_l + rho_r)
5005 h_avg = 5.e-1_wp*(h_l + h_r)
5006 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
5007 qv_avg = 5.e-1_wp*(qv_l + qv_r)
5008 vel_avg_rms = 0._wp
5009
5010
5011# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5012#if defined(MFC_OpenACC)
5013# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5014!$acc loop seq
5015# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5016#elif defined(MFC_OpenMP)
5017# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5018
5019# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5020#endif
5021 do i = 1, num_dims
5022 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
5023 end do
5024 end if
5025
5026 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
5027 & c_l, qv_l)
5028
5029 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
5030 & c_r, qv_r)
5031
5032 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
5033 ! variables are placeholders to call the subroutine.
5034 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
5035 & 0._wp, c_avg, qv_avg)
5036
5037 if (viscous) then
5038
5039# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5040#if defined(MFC_OpenACC)
5041# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5042!$acc loop seq
5043# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5044#elif defined(MFC_OpenMP)
5045# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5046
5047# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5048#endif
5049 do i = 1, 2
5050 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5051 end do
5052 end if
5053
5054 ! Low Mach correction
5055 if (low_mach == 2) then
5056 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5057# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5058 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5059# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5060 pcorr = 0._wp
5061# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5062
5063# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5064 if (low_mach == 1) then
5065# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5066 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5067# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5068 end if
5069# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5070 else if (riemann_solver == riemann_solver_hllc) then
5071# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5072 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5073# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5074 pcorr = 0._wp
5075# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5076
5077# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5078 if (low_mach == 1) then
5079# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5080 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))) &
5081# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5082 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5083# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5084 else if (low_mach == 2) then
5085# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5086 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))))
5087# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5088 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))))
5089# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5090 vel_l(dir_idx(1)) = vel_l_tmp
5091# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5092 vel_r(dir_idx(1)) = vel_r_tmp
5093# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5094 end if
5095# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5096 end if
5097 end if
5098
5099 if (wave_speeds == wave_speeds_direct) then
5100 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5101 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5102
5103 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5104 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
5105 & - rho_r*(s_r - vel_r(dir_idx(1))))
5106 else if (wave_speeds == wave_speeds_pressure) then
5107 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5108
5109 pres_sr = pres_sl
5110
5111 ! Low Mach correction: Thornber et al. JCP (2008)
5112 ms_l = max(1._wp, &
5113 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
5114 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
5115 ms_r = max(1._wp, &
5116 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
5117 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
5118
5119 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5120 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5121
5122 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5123 end if
5124
5125 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5126 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5127
5128 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5129 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5130 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5131 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5132 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5133
5134 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5135 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5136 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5137
5138 ! Low Mach correction
5139 if (low_mach == 1) then
5140 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5141# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5142 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5143# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5144 pcorr = 0._wp
5145# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5146
5147# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5148 if (low_mach == 1) then
5149# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5150 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5151# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5152 end if
5153# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5154 else if (riemann_solver == riemann_solver_hllc) then
5155# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5156 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5157# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5158 pcorr = 0._wp
5159# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5160
5161# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5162 if (low_mach == 1) then
5163# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5164 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))) &
5165# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5166 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5167# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5168 else if (low_mach == 2) then
5169# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5170 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))))
5171# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5172 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))))
5173# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5174 vel_l(dir_idx(1)) = vel_l_tmp
5175# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5176 vel_r(dir_idx(1)) = vel_r_tmp
5177# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5178 end if
5179# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5180 end if
5181 else
5182 pcorr = 0._wp
5183 end if
5184
5185
5186# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5187#if defined(MFC_OpenACC)
5188# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5189!$acc loop seq
5190# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5191#elif defined(MFC_OpenMP)
5192# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5193
5194# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5195#endif
5196 do i = 1, eqn_idx%cont%end
5197 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5198 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5199 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5200 end do
5201
5202 if (bubbles_euler .and. (num_fluids > 1)) then
5203 ! Kill mass transport @ gas density
5204 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5205 end if
5206
5207 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
5208
5209 ! Include p_tilde
5210
5211 if (avg_state == avg_state_arithmetic) then
5212 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
5213 pres_l = pres_l - alpha_l(num_fluids)*pres_l
5214 else
5215 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
5216 end if
5217
5218 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
5219 pres_r = pres_r - alpha_r(num_fluids)*pres_r
5220 else
5221 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
5222 end if
5223 end if
5224
5225
5226# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5227#if defined(MFC_OpenACC)
5228# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5229!$acc loop seq
5230# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5231#elif defined(MFC_OpenMP)
5232# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5233
5234# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5235#endif
5236 do i = 1, num_dims
5237 flux_rsx_vf(j, k, l, &
5238 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
5239 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
5240 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
5241 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5242 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
5243 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
5244 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
5245 end do
5246
5247 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
5248 flux_rsx_vf(j, k, l, &
5249 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
5250 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
5251 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
5252 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
5253 & *pcorr*s_s
5254
5255 ! Volume fraction flux
5256
5257# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5258#if defined(MFC_OpenACC)
5259# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5260!$acc loop seq
5261# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5262#elif defined(MFC_OpenMP)
5263# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5264
5265# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5266#endif
5267 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5268 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5269 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5270 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5271 end do
5272
5273 ! Advection velocity source: interface velocity for volume fraction transport
5274
5275# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5276#if defined(MFC_OpenACC)
5277# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5278!$acc loop seq
5279# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5280#elif defined(MFC_OpenMP)
5281# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5282
5283# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5284#endif
5285 do i = 1, num_dims
5286 vel_src_rsx_vf(j, k, l, &
5287 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
5288 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
5289
5290 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
5291 end do
5292
5293 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5294
5295 ! Add advection flux for bubble variables
5296
5297# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5298#if defined(MFC_OpenACC)
5299# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5300!$acc loop seq
5301# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5302#elif defined(MFC_OpenMP)
5303# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5304
5305# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5306#endif
5307 do i = eqn_idx%bub%beg, eqn_idx%bub%end
5308 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
5309 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5310 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5311 end do
5312
5313 if (qbmm) then
5314 flux_rsx_vf(j, k, l, &
5315 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5316 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5317 end if
5318
5319 if (adv_n) then
5320 flux_rsx_vf(j, k, l, &
5321 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5322 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5323 end if
5324
5325 ! Geometrical source flux for cylindrical coordinates
5326# 1131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5327 if (cyl_coord) then
5328 ! Substituting the advective flux into the inviscid geometrical source flux
5329
5330# 1133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5331#if defined(MFC_OpenACC)
5332# 1133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5333!$acc loop seq
5334# 1133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5335#elif defined(MFC_OpenMP)
5336# 1133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5337
5338# 1133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5339#endif
5340 do i = 1, eqn_idx%E
5341 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5342 end do
5343 ! Recalculating the radial momentum geometric source flux
5344 flux_gsrc_rsx_vf(j, k, l, &
5345 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
5346 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
5347 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
5348 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
5349 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
5350 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
5351 ! Geometrical source of the void fraction(s) is zero
5352
5353# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5354#if defined(MFC_OpenACC)
5355# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5356!$acc loop seq
5357# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5358#elif defined(MFC_OpenMP)
5359# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5360
5361# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5362#endif
5363 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5364 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5365 end do
5366 end if
5367# 1152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5368# 1169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5369 end do
5370 end do
5371 end do
5372
5373# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5374#if defined(MFC_OpenACC)
5375# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5376!$acc end parallel loop
5377# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5378#elif defined(MFC_OpenMP)
5379# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5380
5381# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5382!$omp end target teams loop
5383# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5384#endif
5385 else
5386 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
5387
5388# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5389
5390# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5391#if defined(MFC_OpenACC)
5392# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5393!$acc parallel loop collapse(3) gang vector default(present) &
5394# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5395!$acc& 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, c_sum_Yi_Phi, flux_ene_e) &
5396# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5397!$acc& firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
5398# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5399#elif defined(MFC_OpenMP)
5400# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5401
5402# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5403
5404# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5405
5406# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5407!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5408# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5409!$omp& 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, c_sum_Yi_Phi, flux_ene_e) &
5410# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5411!$omp& firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
5412# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5413#endif
5414# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5415 do l = is3%beg, is3%end
5416 do k = is1%beg, is1%end
5417 do j = is2%beg, is2%end
5418 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5419 rho_l = 0._wp; rho_r = 0._wp
5420 gamma_l = 0._wp; gamma_r = 0._wp
5421 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5422 qv_l = 0._wp; qv_r = 0._wp
5423 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
5424
5425
5426# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5427#if defined(MFC_OpenACC)
5428# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5429!$acc loop seq
5430# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5431#elif defined(MFC_OpenMP)
5432# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5433
5434# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5435#endif
5436 do i = 1, num_fluids
5437 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5438 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5439 end do
5440
5441
5442# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5443#if defined(MFC_OpenACC)
5444# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5445!$acc loop seq
5446# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5447#elif defined(MFC_OpenMP)
5448# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5449
5450# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5451#endif
5452 do i = 1, num_dims
5453 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5454 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
5455 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5456 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5457 end do
5458
5459 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5460 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
5461
5462 ! Change this by splitting it into the cases present in the bubbles_euler
5463 if (mpp_lim) then
5464
5465# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5466#if defined(MFC_OpenACC)
5467# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5468!$acc loop seq
5469# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5470#elif defined(MFC_OpenMP)
5471# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5472
5473# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5474#endif
5475 do i = 1, num_fluids
5476 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5477 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5478 & eqn_idx%E + i)), 1._wp)
5479 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
5480 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
5481 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
5482 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5483 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5484 end do
5485
5486
5487# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5488#if defined(MFC_OpenACC)
5489# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5490!$acc loop seq
5491# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5492#elif defined(MFC_OpenMP)
5493# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5494
5495# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5496#endif
5497 do i = 1, num_fluids
5498 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5499 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5500 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
5501 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5502 end do
5503 end if
5504
5505
5506# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5507#if defined(MFC_OpenACC)
5508# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5509!$acc loop seq
5510# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5511#elif defined(MFC_OpenMP)
5512# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5513
5514# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5515#endif
5516 do i = 1, num_fluids
5517 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
5518 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
5519 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
5520 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
5521
5522 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
5523 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
5524 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
5525 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
5526 end do
5527
5528 re_max = 0
5529 if (re_size_loc1 > 0) re_max = 1
5530 if (re_size_loc2 > 0) re_max = 2
5531
5532 if (viscous) then
5533
5534# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5535#if defined(MFC_OpenACC)
5536# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5537!$acc loop seq
5538# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5539#elif defined(MFC_OpenMP)
5540# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5541
5542# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5543#endif
5544 do i = 1, re_max
5545 re_l(i) = 0._wp
5546 re_r(i) = 0._wp
5547
5548
5549# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5550#if defined(MFC_OpenACC)
5551# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5552!$acc loop seq
5553# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5554#elif defined(MFC_OpenMP)
5555# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5556
5557# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5558#endif
5559 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
5560 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
5561 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
5562 end do
5563
5564 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5565 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5566 end do
5567 end if
5568
5569 if (chemistry) then
5570 c_sum_yi_phi = 0.0_wp
5571
5572# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5573#if defined(MFC_OpenACC)
5574# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5575!$acc loop seq
5576# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5577#elif defined(MFC_OpenMP)
5578# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5579
5580# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5581#endif
5582 do i = eqn_idx%species%beg, eqn_idx%species%end
5583 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5584 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
5585 end do
5586
5587 call get_mixture_molecular_weight(ys_l, mw_l)
5588 call get_mixture_molecular_weight(ys_r, mw_r)
5589
5590 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5591 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5592
5593 r_gas_l = gas_constant/mw_l
5594 r_gas_r = gas_constant/mw_r
5595
5596 t_l = pres_l/rho_l/r_gas_l
5597 t_r = pres_r/rho_r/r_gas_r
5598
5599 call get_species_specific_heats_r(t_l, cp_il)
5600 call get_species_specific_heats_r(t_r, cp_ir)
5601
5602 if (chem_params%gamma_method == 1) then
5603 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5604 gamma_il = cp_il/(cp_il - 1.0_wp)
5605 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5606
5607 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5608 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5609 else if (chem_params%gamma_method == 2) then
5610 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5611 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5612 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5613 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5614 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5615
5616 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
5617 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5618 end if
5619
5620 call get_mixture_energy_mass(t_l, ys_l, e_l)
5621 call get_mixture_energy_mass(t_r, ys_r, e_r)
5622
5623 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5624 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5625 h_l = (e_l + pres_l)/rho_l
5626 h_r = (e_r + pres_r)/rho_r
5627 else
5628 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5629 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5630
5631 h_l = (e_l + pres_l)/rho_l
5632 h_r = (e_r + pres_r)/rho_r
5633 end if
5634
5635 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
5636 if (hypoelasticity) then
5637
5638# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5639#if defined(MFC_OpenACC)
5640# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5641!$acc loop seq
5642# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5643#elif defined(MFC_OpenMP)
5644# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5645
5646# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5647#endif
5648 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5649 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5650 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
5651 end do
5652 g_l = 0._wp
5653 g_r = 0._wp
5654
5655# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5656#if defined(MFC_OpenACC)
5657# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5658!$acc loop seq
5659# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5660#elif defined(MFC_OpenMP)
5661# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5662
5663# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5664#endif
5665 do i = 1, num_fluids
5666 g_l = g_l + alpha_l(i)*gs_rs(i)
5667 g_r = g_r + alpha_r(i)*gs_rs(i)
5668 end do
5669
5670# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5671#if defined(MFC_OpenACC)
5672# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5673!$acc loop seq
5674# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5675#elif defined(MFC_OpenMP)
5676# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5677
5678# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5679#endif
5680 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5681 ! Elastic contribution to energy if G large enough
5682 if ((g_l > verysmall) .and. (g_r > verysmall)) then
5683 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5684 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5685 ! Additional terms in 2D and 3D
5686 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
5687 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5688 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5689 end if
5690 end if
5691 end do
5692 end if
5693
5694 ! Hyperelastic stress contribution: strain energy added to total energy
5695 if (hyperelasticity) then
5696
5697# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5698#if defined(MFC_OpenACC)
5699# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5700!$acc loop seq
5701# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5702#elif defined(MFC_OpenMP)
5703# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5704
5705# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5706#endif
5707 do i = 1, num_dims
5708 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
5709 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
5710 end do
5711 g_l = 0._wp
5712 g_r = 0._wp
5713
5714# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5715#if defined(MFC_OpenACC)
5716# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5717!$acc loop seq
5718# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5719#elif defined(MFC_OpenMP)
5720# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5721
5722# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5723#endif
5724 do i = 1, num_fluids
5725 ! Mixture left and right shear modulus
5726 g_l = g_l + alpha_l(i)*gs_rs(i)
5727 g_r = g_r + alpha_r(i)*gs_rs(i)
5728 end do
5729 ! Elastic contribution to energy if G large enough
5730 if (g_l > verysmall .and. g_r > verysmall) then
5731 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
5732 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
5733 end if
5734
5735# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5736#if defined(MFC_OpenACC)
5737# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5738!$acc loop seq
5739# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5740#elif defined(MFC_OpenMP)
5741# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5742
5743# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5744#endif
5745 do i = 1, b_size - 1
5746 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5747 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
5748 end do
5749 end if
5750
5751 h_l = (e_l + pres_l)/rho_l
5752 h_r = (e_r + pres_r)/rho_r
5753
5754 if (avg_state == avg_state_roe) then
5755# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5756 rho_avg = sqrt(rho_l*rho_r)
5757# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5758
5759# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5760 vel_avg_rms = 0._wp
5761# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5762
5763# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5764
5765# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5766#if defined(MFC_OpenACC)
5767# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5768!$acc loop seq
5769# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5770#elif defined(MFC_OpenMP)
5771# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5772
5773# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5774#endif
5775# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5776 do i = 1, num_vels
5777# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5778 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
5779# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5780 end do
5781# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5782
5783# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5784 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
5785# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5786
5787# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5788 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
5789# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5790
5791# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5792 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
5793# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5794
5795# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5796 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
5797# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5798
5799# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5800 if (chemistry) then
5801# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5802 eps = 0.001_wp
5803# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5804 call get_species_enthalpies_rt(t_l, h_il)
5805# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5806 call get_species_enthalpies_rt(t_r, h_ir)
5807# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5808 h_il = h_il*gas_constant/molecular_weights*t_l
5809# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5810 h_ir = h_ir*gas_constant/molecular_weights*t_r
5811# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5812 call get_species_specific_heats_r(t_l, cp_il)
5813# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5814 call get_species_specific_heats_r(t_r, cp_ir)
5815# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5816
5817# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5818 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
5819# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5820 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
5821# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5822 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
5823# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5824 if (abs(t_l - t_r) < eps) then
5825# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5826 ! Case when T_L and T_R are very close
5827# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5828 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
5829# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5830 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
5831# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5832 & - gas_constant/molecular_weights(:)))
5833# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5834 else
5835# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5836 ! Normal calculation when T_L and T_R are sufficiently different
5837# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5838 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
5839# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5840 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
5841# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5842 end if
5843# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5844 gamma_avg = cp_avg/cv_avg
5845# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5846
5847# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5848 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
5849# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5850 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
5851# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5852 end if
5853# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5854 end if
5855# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5856
5857# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5858 if (avg_state == avg_state_arithmetic) then
5859# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5860 rho_avg = 5.e-1_wp*(rho_l + rho_r)
5861# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5862 vel_avg_rms = 0._wp
5863# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5864
5865# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5866#if defined(MFC_OpenACC)
5867# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5868!$acc loop seq
5869# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5870#elif defined(MFC_OpenMP)
5871# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5872
5873# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5874#endif
5875# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5876 do i = 1, num_vels
5877# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5878 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
5879# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5880 end do
5881# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5882
5883# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5884 h_avg = 5.e-1_wp*(h_l + h_r)
5885# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5886 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
5887# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5888 qv_avg = 5.e-1_wp*(qv_l + qv_r)
5889# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5890 end if
5891
5892 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
5893 & c_l, qv_l)
5894
5895 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
5896 & c_r, qv_r)
5897
5898 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
5899 ! variables are placeholders to call the subroutine.
5900 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
5901 & c_sum_yi_phi, c_avg, qv_avg)
5902
5903 if (viscous) then
5904 if (chemistry) then
5905 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
5906 end if
5907
5908# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5909#if defined(MFC_OpenACC)
5910# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5911!$acc loop seq
5912# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5913#elif defined(MFC_OpenMP)
5914# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5915
5916# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5917#endif
5918 do i = 1, 2
5919 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5920 end do
5921 end if
5922
5923 ! Low Mach correction
5924 if (low_mach == 2) then
5925 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5926# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5927 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5928# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5929 pcorr = 0._wp
5930# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5931
5932# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5933 if (low_mach == 1) then
5934# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5935 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5936# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5937 end if
5938# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5939 else if (riemann_solver == riemann_solver_hllc) then
5940# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5941 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5942# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5943 pcorr = 0._wp
5944# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5945
5946# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5947 if (low_mach == 1) then
5948# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5949 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))) &
5950# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5951 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5952# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5953 else if (low_mach == 2) then
5954# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5955 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))))
5956# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5957 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))))
5958# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5959 vel_l(dir_idx(1)) = vel_l_tmp
5960# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5961 vel_r(dir_idx(1)) = vel_r_tmp
5962# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5963 end if
5964# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5965 end if
5966 end if
5967
5968 if (wave_speeds == wave_speeds_direct) then
5969 if (elasticity) then
5970 ! Elastic wave speed, Rodriguez et al. JCP (2019)
5971 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) &
5972 & ))/rho_l), &
5973 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
5974 & + tau_e_r(dir_idx_tau(1)))/rho_r))
5975 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) &
5976 & ))/rho_r), &
5977 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
5978 & + tau_e_l(dir_idx_tau(1)))/rho_l))
5979 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
5980 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
5981 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
5982 & - vel_r(dir_idx(1))))
5983 else
5984 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5985 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5986 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5987 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
5988 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
5989 end if
5990 else if (wave_speeds == wave_speeds_pressure) then
5991 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5992
5993 pres_sr = pres_sl
5994
5995 ! Low Mach correction: Thornber et al. JCP (2008)
5996 ms_l = max(1._wp, &
5997 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
5998 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
5999 ms_r = max(1._wp, &
6000 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
6001 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
6002
6003 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6004 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6005
6006 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6007 end if
6008
6009 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6010 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6011
6012 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6013 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6014 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6015 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
6016 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6017 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6018
6019 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6020 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
6021 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
6022
6023 ! Low Mach correction
6024 if (low_mach == 1) then
6025 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6026# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6027 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6028# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6029 pcorr = 0._wp
6030# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6031
6032# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6033 if (low_mach == 1) then
6034# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6035 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6036# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6037 end if
6038# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6039 else if (riemann_solver == riemann_solver_hllc) then
6040# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6041 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6042# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6043 pcorr = 0._wp
6044# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6045
6046# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6047 if (low_mach == 1) then
6048# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6049 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))) &
6050# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6051 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6052# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6053 else if (low_mach == 2) then
6054# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6055 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))))
6056# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6057 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))))
6058# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6059 vel_l(dir_idx(1)) = vel_l_tmp
6060# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6061 vel_r(dir_idx(1)) = vel_r_tmp
6062# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6063 end if
6064# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6065 end if
6066 else
6067 pcorr = 0._wp
6068 end if
6069
6070 ! COMPUTING THE HLLC FLUXES MASS FLUX.
6071
6072# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6073#if defined(MFC_OpenACC)
6074# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6075!$acc loop seq
6076# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6077#elif defined(MFC_OpenMP)
6078# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6079
6080# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6081#endif
6082 do i = 1, eqn_idx%cont%end
6083 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6084 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6085 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6086 end do
6087
6088 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
6089 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
6090
6091# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6092#if defined(MFC_OpenACC)
6093# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6094!$acc loop seq
6095# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6096#elif defined(MFC_OpenMP)
6097# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6098
6099# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6100#endif
6101 do i = 1, num_dims
6102 flux_rsx_vf(j, k, l, &
6103 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
6104 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
6105 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
6106 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
6107 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
6108 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
6109 end do
6110
6111 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
6112 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
6113 flux_rsx_vf(j, k, l, &
6114 & 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 &
6115 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
6116 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
6117 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
6118 & *(s_p/s_r)*pcorr*s_s
6119
6120 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
6121 if (elasticity) then
6122 flux_ene_e = 0._wp
6123
6124# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6125#if defined(MFC_OpenACC)
6126# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6127!$acc loop seq
6128# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6129#elif defined(MFC_OpenMP)
6130# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6131
6132# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6133#endif
6134 do i = 1, num_dims
6135 ! MOMENTUM ELASTIC FLUX.
6136 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
6137 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
6138 & - xi_p*tau_e_r(dir_idx_tau(i))
6139 ! ENERGY ELASTIC FLUX.
6140 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
6141 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
6142 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
6143 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
6144 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
6145 end do
6146 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
6147 end if
6148
6149 ! HYPOELASTIC STRESS EVOLUTION FLUX.
6150 if (hypoelasticity) then
6151
6152# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6153#if defined(MFC_OpenACC)
6154# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6155!$acc loop seq
6156# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6157#elif defined(MFC_OpenMP)
6158# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6159
6160# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6161#endif
6162 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6163 flux_rsx_vf(j, k, l, &
6164 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
6165 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
6166 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
6167 end do
6168 end if
6169
6170 ! VOLUME FRACTION FLUX.
6171
6172# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6173#if defined(MFC_OpenACC)
6174# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6175!$acc loop seq
6176# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6177#elif defined(MFC_OpenMP)
6178# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6179
6180# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6181#endif
6182 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6183 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6184 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
6185 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6186 end do
6187
6188 ! VOLUME FRACTION SOURCE FLUX.
6189
6190# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6191#if defined(MFC_OpenACC)
6192# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6193!$acc loop seq
6194# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6195#elif defined(MFC_OpenMP)
6196# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6197
6198# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6199#endif
6200 do i = 1, num_dims
6201 vel_src_rsx_vf(j, k, l, &
6202 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
6203 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
6204 end do
6205
6206 ! COLOR FUNCTION FLUX
6207 if (surface_tension) then
6208 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
6209 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6210 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6211 end if
6212
6213 ! Hyperelastic reference map flux for material deformation tracking
6214 if (hyperelasticity) then
6215
6216# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6217#if defined(MFC_OpenACC)
6218# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6219!$acc loop seq
6220# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6221#elif defined(MFC_OpenMP)
6222# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6223
6224# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6225#endif
6226 do i = 1, num_dims
6227 flux_rsx_vf(j, k, l, &
6228 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
6229 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
6230 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
6231 end do
6232 end if
6233
6234 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6235
6236 if (chemistry) then
6237
6238# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6239#if defined(MFC_OpenACC)
6240# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6241!$acc loop seq
6242# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6243#elif defined(MFC_OpenMP)
6244# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6245
6246# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6247#endif
6248 do i = eqn_idx%species%beg, eqn_idx%species%end
6249 y_l = ql_prim_rsx_vf(j, k, l, i)
6250 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
6251
6252 flux_rsx_vf(j, k, l, &
6253 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6254 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6255 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
6256 end do
6257 end if
6258
6259 ! Geometrical source flux for cylindrical coordinates
6260# 1584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6261 if (cyl_coord) then
6262 ! Substituting the advective flux into the inviscid geometrical source flux
6263
6264# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6265#if defined(MFC_OpenACC)
6266# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6267!$acc loop seq
6268# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6269#elif defined(MFC_OpenMP)
6270# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6271
6272# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6273#endif
6274 do i = 1, eqn_idx%E
6275 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
6276 end do
6277 ! Recalculating the radial momentum geometric source flux
6278 flux_gsrc_rsx_vf(j, k, l, &
6279 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
6280 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
6281 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
6282 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
6283 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
6284 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
6285 ! Geometrical source of the void fraction(s) is zero
6286
6287# 1599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6288#if defined(MFC_OpenACC)
6289# 1599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6290!$acc loop seq
6291# 1599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6292#elif defined(MFC_OpenMP)
6293# 1599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6294
6295# 1599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6296#endif
6297 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6298 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6299 end do
6300 end if
6301# 1605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6302# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6303 end do
6304 end do
6305 end do
6306
6307# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6308#if defined(MFC_OpenACC)
6309# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6310!$acc end parallel loop
6311# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6312#elif defined(MFC_OpenMP)
6313# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6314
6315# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6316!$omp end target teams loop
6317# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6318#endif
6319 end if
6320 end if
6321# 136 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6322# 137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6323# 138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6324 if (norm_dir == 3) then
6325 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6326 if (model_eqns == model_eqns_6eq) then
6327 ! 6-equation model (model_eqns=3): separate phasic internal energies
6328
6329# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6330
6331# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6332#if defined(MFC_OpenACC)
6333# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6334!$acc parallel loop collapse(3) gang vector default(present) &
6335# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6336!$acc& 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) &
6337# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6338!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
6339# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6340#elif defined(MFC_OpenMP)
6341# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6342
6343# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6344
6345# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6346
6347# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6348!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
6349# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6350!$omp& 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) &
6351# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6352!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
6353# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6354#endif
6355# 152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6356 do l = is1%beg, is1%end
6357 do k = is2%beg, is2%end
6358 do j = is3%beg, is3%end
6359 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6360 rho_l = 0._wp; rho_r = 0._wp
6361 gamma_l = 0._wp; gamma_r = 0._wp
6362 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6363 qv_l = 0._wp; qv_r = 0._wp
6364 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6365
6366
6367# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6368#if defined(MFC_OpenACC)
6369# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6370!$acc loop seq
6371# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6372#elif defined(MFC_OpenMP)
6373# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6374
6375# 162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6376#endif
6377 do i = 1, num_dims
6378 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6379 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
6380 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6381 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6382 end do
6383
6384 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6385 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
6386
6387 rho_l = 0._wp
6388 gamma_l = 0._wp
6389 pi_inf_l = 0._wp
6390 qv_l = 0._wp
6391
6392 rho_r = 0._wp
6393 gamma_r = 0._wp
6394 pi_inf_r = 0._wp
6395 qv_r = 0._wp
6396
6397 alpha_l_sum = 0._wp
6398 alpha_r_sum = 0._wp
6399
6400 if (mpp_lim) then
6401
6402# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6403#if defined(MFC_OpenACC)
6404# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6405!$acc loop seq
6406# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6407#elif defined(MFC_OpenMP)
6408# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6409
6410# 187 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6411#endif
6412 do i = 1, num_fluids
6413 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6414 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6415 & eqn_idx%E + i)), 1._wp)
6416 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6417 end do
6418
6419
6420# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6421#if defined(MFC_OpenACC)
6422# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6423!$acc loop seq
6424# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6425#elif defined(MFC_OpenMP)
6426# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6427
6428# 195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6429#endif
6430 do i = 1, num_fluids
6431 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
6432 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
6433 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
6434 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6435 end do
6436
6437
6438# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6439#if defined(MFC_OpenACC)
6440# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6441!$acc loop seq
6442# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6443#elif defined(MFC_OpenMP)
6444# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6445
6446# 203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6447#endif
6448 do i = 1, num_fluids
6449 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6450 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6451 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
6452 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6453 end do
6454 end if
6455
6456
6457# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6458#if defined(MFC_OpenACC)
6459# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6460!$acc loop seq
6461# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6462#elif defined(MFC_OpenMP)
6463# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6464
6465# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6466#endif
6467 do i = 1, num_fluids
6468 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
6469 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
6470 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
6471 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
6472
6473 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
6474 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
6475 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
6476 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
6477
6478 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6479 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
6480 end do
6481
6482 if (viscous) then
6483
6484# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6485#if defined(MFC_OpenACC)
6486# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6487!$acc loop seq
6488# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6489#elif defined(MFC_OpenMP)
6490# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6491
6492# 229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6493#endif
6494 do i = 1, 2
6495 re_l(i) = dflt_real
6496 re_r(i) = dflt_real
6497 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
6498 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
6499
6500# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6501#if defined(MFC_OpenACC)
6502# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6503!$acc loop seq
6504# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6505#elif defined(MFC_OpenMP)
6506# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6507
6508# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6509#endif
6510 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
6511 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
6512 re_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, q))/res_gs(i, &
6513 & q) + re_r(i)
6514 end do
6515 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6516 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6517 end do
6518 end if
6519
6520 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6521 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6522
6523 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6524 if (hypoelasticity) then
6525
6526# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6527#if defined(MFC_OpenACC)
6528# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6529!$acc loop seq
6530# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6531#elif defined(MFC_OpenMP)
6532# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6533
6534# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6535#endif
6536 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6537 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6538 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
6539 end do
6540 g_l = 0._wp; g_r = 0._wp
6541
6542# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6543#if defined(MFC_OpenACC)
6544# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6545!$acc loop seq
6546# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6547#elif defined(MFC_OpenMP)
6548# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6549
6550# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6551#endif
6552 do i = 1, num_fluids
6553 g_l = g_l + alpha_l(i)*gs_rs(i)
6554 g_r = g_r + alpha_r(i)*gs_rs(i)
6555 end do
6556
6557# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6558#if defined(MFC_OpenACC)
6559# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6560!$acc loop seq
6561# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6562#elif defined(MFC_OpenMP)
6563# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6564
6565# 262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6566#endif
6567 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6568 ! Elastic contribution to energy if G large enough
6569 if ((g_l > verysmall) .and. (g_r > verysmall)) then
6570 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6571 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6572 ! Additional terms in 2D and 3D
6573 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
6574 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6575 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6576 end if
6577 end if
6578 end do
6579 end if
6580
6581 ! Hyperelastic stress contribution: strain energy added to total energy
6582 if (hyperelasticity) then
6583
6584# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6585#if defined(MFC_OpenACC)
6586# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6587!$acc loop seq
6588# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6589#elif defined(MFC_OpenMP)
6590# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6591
6592# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6593#endif
6594 do i = 1, num_dims
6595 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
6596 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
6597 end do
6598 g_l = 0._wp; g_r = 0._wp
6599
6600# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6601#if defined(MFC_OpenACC)
6602# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6603!$acc loop seq
6604# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6605#elif defined(MFC_OpenMP)
6606# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6607
6608# 285 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6609#endif
6610 do i = 1, num_fluids
6611 ! Mixture left and right shear modulus
6612 g_l = g_l + alpha_l(i)*gs_rs(i)
6613 g_r = g_r + alpha_r(i)*gs_rs(i)
6614 end do
6615 ! Elastic contribution to energy if G large enough
6616 if (g_l > verysmall .and. g_r > verysmall) then
6617 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
6618 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
6619 end if
6620
6621# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6622#if defined(MFC_OpenACC)
6623# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6624!$acc loop seq
6625# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6626#elif defined(MFC_OpenMP)
6627# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6628
6629# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6630#endif
6631 do i = 1, b_size - 1
6632 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6633 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
6634 end do
6635 end if
6636
6637 h_l = (e_l + pres_l)/rho_l
6638 h_r = (e_r + pres_r)/rho_r
6639
6640 if (avg_state == avg_state_roe) then
6641# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6642 rho_avg = sqrt(rho_l*rho_r)
6643# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6644
6645# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6646 vel_avg_rms = 0._wp
6647# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6648
6649# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6650
6651# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6652#if defined(MFC_OpenACC)
6653# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6654!$acc loop seq
6655# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6656#elif defined(MFC_OpenMP)
6657# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6658
6659# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6660#endif
6661# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6662 do i = 1, num_vels
6663# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6664 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
6665# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6666 end do
6667# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6668
6669# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6670 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6671# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6672
6673# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6674 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6675# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6676
6677# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6678 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
6679# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6680
6681# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6682 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6683# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6684
6685# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6686 if (chemistry) then
6687# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6688 eps = 0.001_wp
6689# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6690 call get_species_enthalpies_rt(t_l, h_il)
6691# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6692 call get_species_enthalpies_rt(t_r, h_ir)
6693# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6694 h_il = h_il*gas_constant/molecular_weights*t_l
6695# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6696 h_ir = h_ir*gas_constant/molecular_weights*t_r
6697# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6698 call get_species_specific_heats_r(t_l, cp_il)
6699# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6700 call get_species_specific_heats_r(t_r, cp_ir)
6701# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6702
6703# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6704 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6705# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6706 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6707# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6708 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6709# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6710 if (abs(t_l - t_r) < eps) then
6711# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6712 ! Case when T_L and T_R are very close
6713# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6714 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6715# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6716 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6717# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6718 & - gas_constant/molecular_weights(:)))
6719# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6720 else
6721# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6722 ! Normal calculation when T_L and T_R are sufficiently different
6723# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6724 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6725# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6726 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6727# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6728 end if
6729# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6730 gamma_avg = cp_avg/cv_avg
6731# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6732
6733# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6734 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6735# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6736 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6737# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6738 end if
6739# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6740 end if
6741# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6742
6743# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6744 if (avg_state == avg_state_arithmetic) then
6745# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6746 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6747# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6748 vel_avg_rms = 0._wp
6749# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6750
6751# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6752#if defined(MFC_OpenACC)
6753# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6754!$acc loop seq
6755# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6756#elif defined(MFC_OpenMP)
6757# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6758
6759# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6760#endif
6761# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6762 do i = 1, num_vels
6763# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6764 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6765# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6766 end do
6767# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6768
6769# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6770 h_avg = 5.e-1_wp*(h_l + h_r)
6771# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6772 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6773# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6774 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6775# 306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6776 end if
6777
6778 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6779 & c_l, qv_l)
6780
6781 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6782 & c_r, qv_r)
6783
6784 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6785 ! variables are placeholders to call the subroutine.
6786 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6787 & 0._wp, c_avg, qv_avg)
6788
6789 if (viscous) then
6790
6791# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6792#if defined(MFC_OpenACC)
6793# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6794!$acc loop seq
6795# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6796#elif defined(MFC_OpenMP)
6797# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6798
6799# 320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6800#endif
6801 do i = 1, 2
6802 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6803 end do
6804 end if
6805
6806 ! Low Mach correction
6807 if (low_mach == 2) then
6808 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6809# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6810 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6811# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6812 pcorr = 0._wp
6813# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6814
6815# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6816 if (low_mach == 1) then
6817# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6818 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6819# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6820 end if
6821# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6822 else if (riemann_solver == riemann_solver_hllc) then
6823# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6824 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6825# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6826 pcorr = 0._wp
6827# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6828
6829# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6830 if (low_mach == 1) then
6831# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6832 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))) &
6833# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6834 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6835# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6836 else if (low_mach == 2) then
6837# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6838 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))))
6839# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6840 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))))
6841# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6842 vel_l(dir_idx(1)) = vel_l_tmp
6843# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6844 vel_r(dir_idx(1)) = vel_r_tmp
6845# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6846 end if
6847# 328 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6848 end if
6849 end if
6850
6851 ! COMPUTING THE DIRECT WAVE SPEEDS
6852 if (wave_speeds == wave_speeds_direct) then
6853 if (elasticity) then
6854 ! Elastic wave speed, Rodriguez et al. JCP (2019)
6855 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) &
6856 & ))/rho_l), &
6857 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
6858 & + tau_e_r(dir_idx_tau(1)))/rho_r))
6859 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) &
6860 & ))/rho_r), &
6861 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
6862 & + tau_e_l(dir_idx_tau(1)))/rho_l))
6863 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
6864 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
6865 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
6866 & - vel_r(dir_idx(1))))
6867 else
6868 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6869 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6870 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6871 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
6872 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
6873 end if
6874 else if (wave_speeds == wave_speeds_pressure) then
6875 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6876
6877 pres_sr = pres_sl
6878
6879 ! Low Mach correction: Thornber et al. JCP (2008)
6880 ms_l = max(1._wp, &
6881 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
6882 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
6883 ms_r = max(1._wp, &
6884 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
6885 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
6886
6887 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6888 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6889
6890 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6891 end if
6892
6893 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6894 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6895
6896 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6897 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6898 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6899 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6900 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6901
6902 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6903 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
6904 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
6905
6906 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
6907 xi_mp = -min(0._wp, sign(1._wp, s_l))
6908 xi_pp = max(0._wp, sign(1._wp, s_r))
6909
6910 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 &
6911 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
6912 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
6913 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
6914 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
6915
6916 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))
6917
6918 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 &
6919 & - vel_r(dir_idx(1)))
6920
6921 ! Low Mach correction
6922 if (low_mach == 1) then
6923 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6924# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6925 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6926# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6927 pcorr = 0._wp
6928# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6929
6930# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6931 if (low_mach == 1) then
6932# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6933 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6934# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6935 end if
6936# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6937 else if (riemann_solver == riemann_solver_hllc) then
6938# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6939 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6940# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6941 pcorr = 0._wp
6942# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6943
6944# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6945 if (low_mach == 1) then
6946# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6947 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))) &
6948# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6949 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6950# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6951 else if (low_mach == 2) then
6952# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6953 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))))
6954# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6955 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))))
6956# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6957 vel_l(dir_idx(1)) = vel_l_tmp
6958# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6959 vel_r(dir_idx(1)) = vel_r_tmp
6960# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6961 end if
6962# 403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6963 end if
6964 else
6965 pcorr = 0._wp
6966 end if
6967
6968 ! COMPUTING FLUXES MASS FLUX.
6969
6970# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6971#if defined(MFC_OpenACC)
6972# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6973!$acc loop seq
6974# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6975#elif defined(MFC_OpenMP)
6976# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6977
6978# 409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6979#endif
6980 do i = 1, eqn_idx%cont%end
6981 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6982 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6983 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6984 end do
6985
6986 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6987
6988# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6989#if defined(MFC_OpenACC)
6990# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6991!$acc loop seq
6992# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6993#elif defined(MFC_OpenMP)
6994# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6995
6996# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6997#endif
6998 do i = 1, num_dims
6999 flux_rsx_vf(j, k, l, &
7000 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
7001 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
7002 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
7003 & *dir_flg(dir_idx(i))*pcorr
7004 end do
7005
7006 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7007 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
7008
7009 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7010 if (elasticity) then
7011 flux_ene_e = 0._wp
7012
7013# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7014#if defined(MFC_OpenACC)
7015# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7016!$acc loop seq
7017# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7018#elif defined(MFC_OpenMP)
7019# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7020
7021# 432 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7022#endif
7023 do i = 1, num_dims
7024 ! MOMENTUM ELASTIC FLUX.
7025 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7026 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
7027 & - xi_p*tau_e_r(dir_idx_tau(i))
7028 ! ENERGY ELASTIC FLUX.
7029 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
7030 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
7031 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
7032 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
7033 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
7034 end do
7035 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
7036 end if
7037
7038 ! VOLUME FRACTION FLUX.
7039
7040# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7041#if defined(MFC_OpenACC)
7042# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7043!$acc loop seq
7044# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7045#elif defined(MFC_OpenMP)
7046# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7047
7048# 449 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7049#endif
7050 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7051 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7052 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
7053 end do
7054
7055 ! Advection velocity source: interface velocity for volume fraction transport
7056
7057# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7058#if defined(MFC_OpenACC)
7059# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7060!$acc loop seq
7061# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7062#elif defined(MFC_OpenMP)
7063# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7064
7065# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7066#endif
7067 do i = 1, num_dims
7068 vel_src_rsx_vf(j, k, l, &
7069 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
7070 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
7071 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
7072 end do
7073
7074 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7075 ! energy flux
7076
7077# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7078#if defined(MFC_OpenACC)
7079# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7080!$acc loop seq
7081# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7082#elif defined(MFC_OpenMP)
7083# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7084
7085# 466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7086#endif
7087 do i = 1, num_fluids
7088 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7089 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7090 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7091 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7092 & + pres_r)
7093
7094 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7095 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7096 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7097 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7098 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7099 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7100 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7101 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7102 & i + eqn_idx%adv%beg - 1))
7103 end do
7104
7105 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7106
7107 ! HYPOELASTIC STRESS EVOLUTION FLUX.
7108 if (hypoelasticity) then
7109
7110# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7111#if defined(MFC_OpenACC)
7112# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7113!$acc loop seq
7114# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7115#elif defined(MFC_OpenMP)
7116# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7117
7118# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7119#endif
7120 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7121 flux_rsx_vf(j, k, l, &
7122 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
7123 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7124 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
7125 end do
7126 end if
7127
7128 ! Hyperelastic reference map flux for material deformation tracking
7129 if (hyperelasticity) then
7130
7131# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7132#if defined(MFC_OpenACC)
7133# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7134!$acc loop seq
7135# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7136#elif defined(MFC_OpenMP)
7137# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7138
7139# 500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7140#endif
7141 do i = 1, num_dims
7142 flux_rsx_vf(j, k, l, &
7143 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
7144 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7145 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
7146 end do
7147 end if
7148
7149 ! COLOR FUNCTION FLUX
7150 if (surface_tension) then
7151 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7152 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
7153 end if
7154
7155 ! Geometrical source flux for cylindrical coordinates
7156# 538 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7157# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7158 if (grid_geometry == 3) then
7159
7160# 540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7161#if defined(MFC_OpenACC)
7162# 540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7163!$acc loop seq
7164# 540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7165#elif defined(MFC_OpenMP)
7166# 540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7167
7168# 540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7169#endif
7170 do i = 1, sys_size
7171 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7172 end do
7173 flux_gsrc_rsx_vf(j, k, l, &
7174 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
7175 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
7176
7177 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7178 end if
7179# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7180 end do
7181 end do
7182 end do
7183
7184# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7185#if defined(MFC_OpenACC)
7186# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7187!$acc end parallel loop
7188# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7189#elif defined(MFC_OpenMP)
7190# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7191
7192# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7193!$omp end target teams loop
7194# 554 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7195#endif
7196 else if (model_eqns == model_eqns_4eq) then
7197 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
7198
7199# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7200
7201# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7202#if defined(MFC_OpenACC)
7203# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7204!$acc parallel loop collapse(3) gang vector default(present) &
7205# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7206!$acc& 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)
7207# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7208#elif defined(MFC_OpenMP)
7209# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7210
7211# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7212
7213# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7214
7215# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7216!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
7217# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7218!$omp& 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)
7219# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7220#endif
7221# 566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7222 do l = is1%beg, is1%end
7223 do k = is2%beg, is2%end
7224 do j = is3%beg, is3%end
7225 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7226 rho_l = 0._wp; rho_r = 0._wp
7227 gamma_l = 0._wp; gamma_r = 0._wp
7228 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7229 qv_l = 0._wp; qv_r = 0._wp
7230
7231
7232# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7233#if defined(MFC_OpenACC)
7234# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7235!$acc loop seq
7236# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7237#elif defined(MFC_OpenMP)
7238# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7239
7240# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7241#endif
7242 do i = 1, eqn_idx%cont%end
7243 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7244 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7245 end do
7246
7247
7248# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7249#if defined(MFC_OpenACC)
7250# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7251!$acc loop seq
7252# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7253#elif defined(MFC_OpenMP)
7254# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7255
7256# 581 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7257#endif
7258 do i = 1, num_dims
7259 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7260 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7261 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7262 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7263 end do
7264
7265
7266# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7267#if defined(MFC_OpenACC)
7268# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7269!$acc loop seq
7270# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7271#elif defined(MFC_OpenMP)
7272# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7273
7274# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7275#endif
7276 do i = 1, num_fluids
7277 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7278 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7279 end do
7280
7281# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7282#if defined(MFC_OpenACC)
7283# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7284!$acc loop seq
7285# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7286#elif defined(MFC_OpenMP)
7287# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7288
7289# 594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7290#endif
7291 do i = 1, num_fluids
7292 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7293 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7294 end do
7295
7296
7297# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7298#if defined(MFC_OpenACC)
7299# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7300!$acc loop seq
7301# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7302#elif defined(MFC_OpenMP)
7303# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7304
7305# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7306#endif
7307 do i = 1, num_fluids
7308 rho_l = rho_l + alpha_rho_l(i)
7309 gamma_l = gamma_l + alpha_l(i)*gammas(i)
7310 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
7311 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
7312
7313 rho_r = rho_r + alpha_rho_r(i)
7314 gamma_r = gamma_r + alpha_r(i)*gammas(i)
7315 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
7316 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
7317 end do
7318
7319 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7320 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7321
7322 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7323 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7324
7325 h_l = (e_l + pres_l)/rho_l
7326 h_r = (e_r + pres_r)/rho_r
7327
7328 if (avg_state == avg_state_roe) then
7329# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7330 rho_avg = sqrt(rho_l*rho_r)
7331# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7332
7333# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7334 vel_avg_rms = 0._wp
7335# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7336
7337# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7338
7339# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7340#if defined(MFC_OpenACC)
7341# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7342!$acc loop seq
7343# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7344#elif defined(MFC_OpenMP)
7345# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7346
7347# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7348#endif
7349# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7350 do i = 1, num_vels
7351# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7352 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
7353# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7354 end do
7355# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7356
7357# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7358 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7359# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7360
7361# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7362 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7363# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7364
7365# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7366 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
7367# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7368
7369# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7370 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7371# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7372
7373# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7374 if (chemistry) then
7375# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7376 eps = 0.001_wp
7377# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7378 call get_species_enthalpies_rt(t_l, h_il)
7379# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7380 call get_species_enthalpies_rt(t_r, h_ir)
7381# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7382 h_il = h_il*gas_constant/molecular_weights*t_l
7383# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7384 h_ir = h_ir*gas_constant/molecular_weights*t_r
7385# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7386 call get_species_specific_heats_r(t_l, cp_il)
7387# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7388 call get_species_specific_heats_r(t_r, cp_ir)
7389# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7390
7391# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7392 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7393# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7394 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7395# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7396 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7397# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7398 if (abs(t_l - t_r) < eps) then
7399# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7400 ! Case when T_L and T_R are very close
7401# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7402 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7403# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7404 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7405# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7406 & - gas_constant/molecular_weights(:)))
7407# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7408 else
7409# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7410 ! Normal calculation when T_L and T_R are sufficiently different
7411# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7412 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7413# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7414 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7415# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7416 end if
7417# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7418 gamma_avg = cp_avg/cv_avg
7419# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7420
7421# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7422 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7423# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7424 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7425# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7426 end if
7427# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7428 end if
7429# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7430
7431# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7432 if (avg_state == avg_state_arithmetic) then
7433# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7434 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7435# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7436 vel_avg_rms = 0._wp
7437# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7438
7439# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7440#if defined(MFC_OpenACC)
7441# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7442!$acc loop seq
7443# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7444#elif defined(MFC_OpenMP)
7445# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7446
7447# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7448#endif
7449# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7450 do i = 1, num_vels
7451# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7452 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7453# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7454 end do
7455# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7456
7457# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7458 h_avg = 5.e-1_wp*(h_l + h_r)
7459# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7460 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7461# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7462 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7463# 622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7464 end if
7465
7466 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7467 & c_l, qv_l)
7468
7469 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7470 & c_r, qv_r)
7471
7472 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7473 ! variables are placeholders to call the subroutine.
7474
7475 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7476 & 0._wp, c_avg, qv_avg)
7477
7478 if (wave_speeds == wave_speeds_direct) then
7479 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7480 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7481
7482 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7483 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7484 & - rho_r*(s_r - vel_r(dir_idx(1))))
7485 else if (wave_speeds == wave_speeds_pressure) then
7486 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7487
7488 pres_sr = pres_sl
7489
7490 ! Low Mach correction: Thornber et al. JCP (2008)
7491 ms_l = max(1._wp, &
7492 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7493 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7494 ms_r = max(1._wp, &
7495 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7496 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7497
7498 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7499 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7500
7501 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7502 end if
7503
7504 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7505 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7506
7507 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7508 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7509 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7510 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7511 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7512
7513 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7514 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7515 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7516
7517
7518# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7519#if defined(MFC_OpenACC)
7520# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7521!$acc loop seq
7522# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7523#elif defined(MFC_OpenMP)
7524# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7525
7526# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7527#endif
7528 do i = 1, eqn_idx%cont%end
7529 flux_rsx_vf(j, k, l, &
7530 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
7531 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7532 end do
7533
7534 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7535
7536# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7537#if defined(MFC_OpenACC)
7538# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7539!$acc loop seq
7540# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7541#elif defined(MFC_OpenMP)
7542# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7543
7544# 683 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7545#endif
7546 do i = 1, num_dims
7547 flux_rsx_vf(j, k, l, &
7548 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
7549 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7550 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
7551 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7552 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7553 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
7554 end do
7555
7556 if (bubbles_euler) then
7557 ! Put p_tilde in
7558
7559# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7560#if defined(MFC_OpenACC)
7561# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7562!$acc loop seq
7563# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7564#elif defined(MFC_OpenMP)
7565# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7566
7567# 696 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7568#endif
7569 do i = 1, num_dims
7570 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7571 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
7572 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
7573 end do
7574 end if
7575
7576 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
7577
7578
7579# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7580#if defined(MFC_OpenACC)
7581# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7582!$acc loop seq
7583# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7584#elif defined(MFC_OpenMP)
7585# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7586
7587# 706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7588#endif
7589 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
7590 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7591 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7592 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7593 end do
7594
7595 ! Advection velocity source: interface velocity for volume fraction transport
7596
7597# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7598#if defined(MFC_OpenACC)
7599# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7600!$acc loop seq
7601# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7602#elif defined(MFC_OpenMP)
7603# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7604
7605# 714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7606#endif
7607 do i = 1, num_dims
7608 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
7609 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7610 end do
7611
7612 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7613
7614 ! Add advection flux for bubble variables
7615 if (bubbles_euler) then
7616
7617# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7618#if defined(MFC_OpenACC)
7619# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7620!$acc loop seq
7621# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7622#elif defined(MFC_OpenMP)
7623# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7624
7625# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7626#endif
7627 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7628 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7629 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7630 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, &
7631 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7632 end do
7633 end if
7634
7635 ! Geometrical source flux for cylindrical coordinates
7636
7637# 757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7638# 758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7639 if (grid_geometry == 3) then
7640
7641# 759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7642#if defined(MFC_OpenACC)
7643# 759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7644!$acc loop seq
7645# 759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7646#elif defined(MFC_OpenMP)
7647# 759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7648
7649# 759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7650#endif
7651 do i = 1, sys_size
7652 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7653 end do
7654 flux_gsrc_rsx_vf(j, k, l, &
7655 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
7656 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
7657 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
7658 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
7659 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
7660 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
7661 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7662 end if
7663# 773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7664 end do
7665 end do
7666 end do
7667
7668# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7669#if defined(MFC_OpenACC)
7670# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7671!$acc end parallel loop
7672# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7673#elif defined(MFC_OpenMP)
7674# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7675
7676# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7677!$omp end target teams loop
7678# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7679#endif
7680 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
7681 ! 5-equation model with Euler-Euler bubble dynamics
7682
7683# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7684
7685# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7686#if defined(MFC_OpenACC)
7687# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7688!$acc parallel loop collapse(3) gang vector default(present) &
7689# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7690!$acc& 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) &
7691# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7692!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
7693# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7694#elif defined(MFC_OpenMP)
7695# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7696
7697# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7698
7699# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7700
7701# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7702!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
7703# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7704!$omp& 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) &
7705# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7706!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
7707# 779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7708#endif
7709# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7710 do l = is1%beg, is1%end
7711 do k = is2%beg, is2%end
7712 do j = is3%beg, is3%end
7713 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7714 rho_l = 0._wp; rho_r = 0._wp
7715 gamma_l = 0._wp; gamma_r = 0._wp
7716 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7717 qv_l = 0._wp; qv_r = 0._wp
7718
7719
7720# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7721#if defined(MFC_OpenACC)
7722# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7723!$acc loop seq
7724# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7725#elif defined(MFC_OpenMP)
7726# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7727
7728# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7729#endif
7730 do i = 1, num_fluids
7731 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7732 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7733 end do
7734
7735 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7736
7737
7738# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7739#if defined(MFC_OpenACC)
7740# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7741!$acc loop seq
7742# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7743#elif defined(MFC_OpenMP)
7744# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7745
7746# 804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7747#endif
7748 do i = 1, num_dims
7749 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7750 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7751 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7752 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7753 end do
7754
7755 ! Retain this in the refactor
7756 if (mpp_lim .and. (num_fluids > 2)) then
7757
7758# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7759#if defined(MFC_OpenACC)
7760# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7761!$acc loop seq
7762# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7763#elif defined(MFC_OpenMP)
7764# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7765
7766# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7767#endif
7768 do i = 1, num_fluids
7769 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7770 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7771 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7772 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7773 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
7774 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
7775 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
7776 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
7777 end do
7778 else if (num_fluids > 2) then
7779
7780# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7781#if defined(MFC_OpenACC)
7782# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7783!$acc loop seq
7784# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7785#elif defined(MFC_OpenMP)
7786# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7787
7788# 826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7789#endif
7790 do i = 1, num_fluids - 1
7791 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7792 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7793 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7794 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7795 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
7796 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
7797 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
7798 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
7799 end do
7800 else
7801 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7802 gamma_l = gammas(1)
7803 pi_inf_l = pi_infs(1)
7804 qv_l = qvs(1)
7805 rho_r = qr_prim_rsx_vf(j, k, l + 1, 1)
7806 gamma_r = gammas(1)
7807 pi_inf_r = pi_infs(1)
7808 qv_r = qvs(1)
7809 end if
7810
7811 if (viscous) then
7812 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7813
7814# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7815#if defined(MFC_OpenACC)
7816# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7817!$acc loop seq
7818# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7819#elif defined(MFC_OpenMP)
7820# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7821
7822# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7823#endif
7824 do i = 1, 2
7825 re_l(i) = dflt_real
7826 re_r(i) = dflt_real
7827
7828 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
7829 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
7830
7831
7832# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7833#if defined(MFC_OpenACC)
7834# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7835!$acc loop seq
7836# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7837#elif defined(MFC_OpenMP)
7838# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7839
7840# 858 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7841#endif
7842 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
7843 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7844 & q)))/res_gs(i, q) + re_l(i)
7845 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
7846 & q)))/res_gs(i, q) + re_r(i)
7847 end do
7848
7849 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7850 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7851 end do
7852 end if
7853 end if
7854
7855 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7856 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7857
7858 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7859 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7860
7861 h_l = (e_l + pres_l)/rho_l
7862 h_r = (e_r + pres_r)/rho_r
7863
7864 if (avg_state == avg_state_arithmetic) then
7865
7866# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7867#if defined(MFC_OpenACC)
7868# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7869!$acc loop seq
7870# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7871#elif defined(MFC_OpenMP)
7872# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7873
7874# 882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7875#endif
7876 do i = 1, nb
7877 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7878 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
7879
7880 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
7881 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
7882 if (.not. polytropic .and. .not. qbmm) then
7883 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
7884 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
7885 end if
7886 end do
7887
7888 if (.not. qbmm) then
7889 if (adv_n) then
7890 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
7891 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
7892 else
7893 nbub_l = 0._wp
7894 nbub_r = 0._wp
7895
7896# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7897#if defined(MFC_OpenACC)
7898# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7899!$acc loop seq
7900# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7901#elif defined(MFC_OpenMP)
7902# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7903
7904# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7905#endif
7906 do i = 1, nb
7907 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
7908 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
7909 end do
7910
7911 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
7912 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
7913 & eqn_idx%E + num_fluids)/nbub_r
7914 end if
7915 else
7916 ! nb stored in 0th moment of first R0 bin in variable conversion module
7917 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
7918 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
7919 end if
7920
7921
7922# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7923#if defined(MFC_OpenACC)
7924# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7925!$acc loop seq
7926# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7927#elif defined(MFC_OpenMP)
7928# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7929
7930# 918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7931#endif
7932 do i = 1, nb
7933 if (.not. qbmm) then
7934 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
7935 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
7936 end if
7937 end do
7938
7939 if (qbmm) then
7940 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
7941 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
7942
7943 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
7944 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
7945
7946 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
7947 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
7948 else
7949 pbwr3lbar = 0._wp
7950 pbwr3rbar = 0._wp
7951
7952 r3lbar = 0._wp
7953 r3rbar = 0._wp
7954
7955 r3v2lbar = 0._wp
7956 r3v2rbar = 0._wp
7957
7958
7959# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7960#if defined(MFC_OpenACC)
7961# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7962!$acc loop seq
7963# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7964#elif defined(MFC_OpenMP)
7965# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7966
7967# 945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7968#endif
7969 do i = 1, nb
7970 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
7971 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
7972
7973 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
7974 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
7975
7976 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
7977 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
7978 end do
7979 end if
7980
7981 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7982 h_avg = 5.e-1_wp*(h_l + h_r)
7983 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7984 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7985 vel_avg_rms = 0._wp
7986
7987
7988# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7989#if defined(MFC_OpenACC)
7990# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7991!$acc loop seq
7992# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7993#elif defined(MFC_OpenMP)
7994# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7995
7996# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7997#endif
7998 do i = 1, num_dims
7999 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8000 end do
8001 end if
8002
8003 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8004 & c_l, qv_l)
8005
8006 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8007 & c_r, qv_r)
8008
8009 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8010 ! variables are placeholders to call the subroutine.
8011 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8012 & 0._wp, c_avg, qv_avg)
8013
8014 if (viscous) then
8015
8016# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8017#if defined(MFC_OpenACC)
8018# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8019!$acc loop seq
8020# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8021#elif defined(MFC_OpenMP)
8022# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8023
8024# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8025#endif
8026 do i = 1, 2
8027 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8028 end do
8029 end if
8030
8031 ! Low Mach correction
8032 if (low_mach == 2) then
8033 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8034# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8035 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8036# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8037 pcorr = 0._wp
8038# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8039
8040# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8041 if (low_mach == 1) then
8042# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8043 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8044# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8045 end if
8046# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8047 else if (riemann_solver == riemann_solver_hllc) then
8048# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8049 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8050# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8051 pcorr = 0._wp
8052# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8053
8054# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8055 if (low_mach == 1) then
8056# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8057 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))) &
8058# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8059 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8060# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8061 else if (low_mach == 2) then
8062# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8063 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))))
8064# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8065 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))))
8066# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8067 vel_l(dir_idx(1)) = vel_l_tmp
8068# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8069 vel_r(dir_idx(1)) = vel_r_tmp
8070# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8071 end if
8072# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8073 end if
8074 end if
8075
8076 if (wave_speeds == wave_speeds_direct) then
8077 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8078 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8079
8080 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8081 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
8082 & - rho_r*(s_r - vel_r(dir_idx(1))))
8083 else if (wave_speeds == wave_speeds_pressure) then
8084 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8085
8086 pres_sr = pres_sl
8087
8088 ! Low Mach correction: Thornber et al. JCP (2008)
8089 ms_l = max(1._wp, &
8090 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8091 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8092 ms_r = max(1._wp, &
8093 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8094 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8095
8096 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8097 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8098
8099 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8100 end if
8101
8102 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8103 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8104
8105 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8106 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8107 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8108 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8109 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8110
8111 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8112 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8113 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8114
8115 ! Low Mach correction
8116 if (low_mach == 1) then
8117 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8118# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8119 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8120# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8121 pcorr = 0._wp
8122# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8123
8124# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8125 if (low_mach == 1) then
8126# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8127 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8128# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8129 end if
8130# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8131 else if (riemann_solver == riemann_solver_hllc) then
8132# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8133 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8134# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8135 pcorr = 0._wp
8136# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8137
8138# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8139 if (low_mach == 1) then
8140# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8141 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))) &
8142# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8143 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8144# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8145 else if (low_mach == 2) then
8146# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8147 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))))
8148# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8149 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))))
8150# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8151 vel_l(dir_idx(1)) = vel_l_tmp
8152# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8153 vel_r(dir_idx(1)) = vel_r_tmp
8154# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8155 end if
8156# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8157 end if
8158 else
8159 pcorr = 0._wp
8160 end if
8161
8162
8163# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8164#if defined(MFC_OpenACC)
8165# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8166!$acc loop seq
8167# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8168#elif defined(MFC_OpenMP)
8169# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8170
8171# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8172#endif
8173 do i = 1, eqn_idx%cont%end
8174 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8175 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8176 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8177 end do
8178
8179 if (bubbles_euler .and. (num_fluids > 1)) then
8180 ! Kill mass transport @ gas density
8181 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
8182 end if
8183
8184 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8185
8186 ! Include p_tilde
8187
8188 if (avg_state == avg_state_arithmetic) then
8189 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
8190 pres_l = pres_l - alpha_l(num_fluids)*pres_l
8191 else
8192 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
8193 end if
8194
8195 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
8196 pres_r = pres_r - alpha_r(num_fluids)*pres_r
8197 else
8198 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
8199 end if
8200 end if
8201
8202
8203# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8204#if defined(MFC_OpenACC)
8205# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8206!$acc loop seq
8207# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8208#elif defined(MFC_OpenMP)
8209# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8210
8211# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8212#endif
8213 do i = 1, num_dims
8214 flux_rsx_vf(j, k, l, &
8215 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
8216 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8217 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
8218 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
8219 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8220 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
8221 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8222 end do
8223
8224 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
8225 flux_rsx_vf(j, k, l, &
8226 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
8227 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
8228 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
8229 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
8230 & *pcorr*s_s
8231
8232 ! Volume fraction flux
8233
8234# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8235#if defined(MFC_OpenACC)
8236# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8237!$acc loop seq
8238# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8239#elif defined(MFC_OpenMP)
8240# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8241
8242# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8243#endif
8244 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8245 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8246 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8247 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8248 end do
8249
8250 ! Advection velocity source: interface velocity for volume fraction transport
8251
8252# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8253#if defined(MFC_OpenACC)
8254# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8255!$acc loop seq
8256# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8257#elif defined(MFC_OpenMP)
8258# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8259
8260# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8261#endif
8262 do i = 1, num_dims
8263 vel_src_rsx_vf(j, k, l, &
8264 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8265 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8266
8267 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8268 end do
8269
8270 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8271
8272 ! Add advection flux for bubble variables
8273
8274# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8275#if defined(MFC_OpenACC)
8276# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8277!$acc loop seq
8278# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8279#elif defined(MFC_OpenMP)
8280# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8281
8282# 1110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8283#endif
8284 do i = eqn_idx%bub%beg, eqn_idx%bub%end
8285 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
8286 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8287 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8288 end do
8289
8290 if (qbmm) then
8291 flux_rsx_vf(j, k, l, &
8292 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8293 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8294 end if
8295
8296 if (adv_n) then
8297 flux_rsx_vf(j, k, l, &
8298 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8299 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8300 end if
8301
8302 ! Geometrical source flux for cylindrical coordinates
8303# 1152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8304# 1153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8305 if (grid_geometry == 3) then
8306
8307# 1154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8308#if defined(MFC_OpenACC)
8309# 1154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8310!$acc loop seq
8311# 1154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8312#elif defined(MFC_OpenMP)
8313# 1154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8314
8315# 1154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8316#endif
8317 do i = 1, sys_size
8318 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
8319 end do
8320
8321 flux_gsrc_rsx_vf(j, k, l, &
8322 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
8323 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
8324 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
8325 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
8326 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
8327 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
8328 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
8329 end if
8330# 1169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8331 end do
8332 end do
8333 end do
8334
8335# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8336#if defined(MFC_OpenACC)
8337# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8338!$acc end parallel loop
8339# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8340#elif defined(MFC_OpenMP)
8341# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8342
8343# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8344!$omp end target teams loop
8345# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8346#endif
8347 else
8348 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
8349
8350# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8351
8352# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8353#if defined(MFC_OpenACC)
8354# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8355!$acc parallel loop collapse(3) gang vector default(present) &
8356# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8357!$acc& 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, c_sum_Yi_Phi, flux_ene_e) &
8358# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8359!$acc& firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
8360# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8361#elif defined(MFC_OpenMP)
8362# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8363
8364# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8365
8366# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8367
8368# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8369!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
8370# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8371!$omp& 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, c_sum_Yi_Phi, flux_ene_e) &
8372# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8373!$omp& firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
8374# 1175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8375#endif
8376# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8377 do l = is1%beg, is1%end
8378 do k = is2%beg, is2%end
8379 do j = is3%beg, is3%end
8380 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8381 rho_l = 0._wp; rho_r = 0._wp
8382 gamma_l = 0._wp; gamma_r = 0._wp
8383 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8384 qv_l = 0._wp; qv_r = 0._wp
8385 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8386
8387
8388# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8389#if defined(MFC_OpenACC)
8390# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8391!$acc loop seq
8392# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8393#elif defined(MFC_OpenMP)
8394# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8395
8396# 1194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8397#endif
8398 do i = 1, num_fluids
8399 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8400 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8401 end do
8402
8403
8404# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8405#if defined(MFC_OpenACC)
8406# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8407!$acc loop seq
8408# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8409#elif defined(MFC_OpenMP)
8410# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8411
8412# 1200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8413#endif
8414 do i = 1, num_dims
8415 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8416 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
8417 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8418 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8419 end do
8420
8421 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8422 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
8423
8424 ! Change this by splitting it into the cases present in the bubbles_euler
8425 if (mpp_lim) then
8426
8427# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8428#if defined(MFC_OpenACC)
8429# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8430!$acc loop seq
8431# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8432#elif defined(MFC_OpenMP)
8433# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8434
8435# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8436#endif
8437 do i = 1, num_fluids
8438 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8439 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8440 & eqn_idx%E + i)), 1._wp)
8441 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
8442 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
8443 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
8444 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8445 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
8446 end do
8447
8448
8449# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8450#if defined(MFC_OpenACC)
8451# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8452!$acc loop seq
8453# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8454#elif defined(MFC_OpenMP)
8455# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8456
8457# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8458#endif
8459 do i = 1, num_fluids
8460 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8461 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8462 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
8463 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8464 end do
8465 end if
8466
8467
8468# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8469#if defined(MFC_OpenACC)
8470# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8471!$acc loop seq
8472# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8473#elif defined(MFC_OpenMP)
8474# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8475
8476# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8477#endif
8478 do i = 1, num_fluids
8479 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8480 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
8481 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
8482 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8483
8484 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
8485 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
8486 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
8487 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
8488 end do
8489
8490 re_max = 0
8491 if (re_size_loc1 > 0) re_max = 1
8492 if (re_size_loc2 > 0) re_max = 2
8493
8494 if (viscous) then
8495
8496# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8497#if defined(MFC_OpenACC)
8498# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8499!$acc loop seq
8500# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8501#elif defined(MFC_OpenMP)
8502# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8503
8504# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8505#endif
8506 do i = 1, re_max
8507 re_l(i) = 0._wp
8508 re_r(i) = 0._wp
8509
8510
8511# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8512#if defined(MFC_OpenACC)
8513# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8514!$acc loop seq
8515# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8516#elif defined(MFC_OpenMP)
8517# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8518
8519# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8520#endif
8521 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
8522 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
8523 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
8524 end do
8525
8526 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8527 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8528 end do
8529 end if
8530
8531 if (chemistry) then
8532 c_sum_yi_phi = 0.0_wp
8533
8534# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8535#if defined(MFC_OpenACC)
8536# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8537!$acc loop seq
8538# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8539#elif defined(MFC_OpenMP)
8540# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8541
8542# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8543#endif
8544 do i = eqn_idx%species%beg, eqn_idx%species%end
8545 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8546 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
8547 end do
8548
8549 call get_mixture_molecular_weight(ys_l, mw_l)
8550 call get_mixture_molecular_weight(ys_r, mw_r)
8551
8552 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8553 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8554
8555 r_gas_l = gas_constant/mw_l
8556 r_gas_r = gas_constant/mw_r
8557
8558 t_l = pres_l/rho_l/r_gas_l
8559 t_r = pres_r/rho_r/r_gas_r
8560
8561 call get_species_specific_heats_r(t_l, cp_il)
8562 call get_species_specific_heats_r(t_r, cp_ir)
8563
8564 if (chem_params%gamma_method == 1) then
8565 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8566 gamma_il = cp_il/(cp_il - 1.0_wp)
8567 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8568
8569 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8570 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8571 else if (chem_params%gamma_method == 2) then
8572 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8573 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8574 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8575 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8576 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8577
8578 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8579 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8580 end if
8581
8582 call get_mixture_energy_mass(t_l, ys_l, e_l)
8583 call get_mixture_energy_mass(t_r, ys_r, e_r)
8584
8585 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8586 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8587 h_l = (e_l + pres_l)/rho_l
8588 h_r = (e_r + pres_r)/rho_r
8589 else
8590 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8591 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8592
8593 h_l = (e_l + pres_l)/rho_l
8594 h_r = (e_r + pres_r)/rho_r
8595 end if
8596
8597 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8598 if (hypoelasticity) then
8599
8600# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8601#if defined(MFC_OpenACC)
8602# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8603!$acc loop seq
8604# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8605#elif defined(MFC_OpenMP)
8606# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8607
8608# 1326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8609#endif
8610 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8611 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8612 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
8613 end do
8614 g_l = 0._wp
8615 g_r = 0._wp
8616
8617# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8618#if defined(MFC_OpenACC)
8619# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8620!$acc loop seq
8621# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8622#elif defined(MFC_OpenMP)
8623# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8624
8625# 1333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8626#endif
8627 do i = 1, num_fluids
8628 g_l = g_l + alpha_l(i)*gs_rs(i)
8629 g_r = g_r + alpha_r(i)*gs_rs(i)
8630 end do
8631
8632# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8633#if defined(MFC_OpenACC)
8634# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8635!$acc loop seq
8636# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8637#elif defined(MFC_OpenMP)
8638# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8639
8640# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8641#endif
8642 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8643 ! Elastic contribution to energy if G large enough
8644 if ((g_l > verysmall) .and. (g_r > verysmall)) then
8645 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8646 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8647 ! Additional terms in 2D and 3D
8648 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
8649 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8650 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8651 end if
8652 end if
8653 end do
8654 end if
8655
8656 ! Hyperelastic stress contribution: strain energy added to total energy
8657 if (hyperelasticity) then
8658
8659# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8660#if defined(MFC_OpenACC)
8661# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8662!$acc loop seq
8663# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8664#elif defined(MFC_OpenMP)
8665# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8666
8667# 1355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8668#endif
8669 do i = 1, num_dims
8670 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
8671 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
8672 end do
8673 g_l = 0._wp
8674 g_r = 0._wp
8675
8676# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8677#if defined(MFC_OpenACC)
8678# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8679!$acc loop seq
8680# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8681#elif defined(MFC_OpenMP)
8682# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8683
8684# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8685#endif
8686 do i = 1, num_fluids
8687 ! Mixture left and right shear modulus
8688 g_l = g_l + alpha_l(i)*gs_rs(i)
8689 g_r = g_r + alpha_r(i)*gs_rs(i)
8690 end do
8691 ! Elastic contribution to energy if G large enough
8692 if (g_l > verysmall .and. g_r > verysmall) then
8693 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
8694 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
8695 end if
8696
8697# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8698#if defined(MFC_OpenACC)
8699# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8700!$acc loop seq
8701# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8702#elif defined(MFC_OpenMP)
8703# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8704
8705# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8706#endif
8707 do i = 1, b_size - 1
8708 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8709 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
8710 end do
8711 end if
8712
8713 h_l = (e_l + pres_l)/rho_l
8714 h_r = (e_r + pres_r)/rho_r
8715
8716 if (avg_state == avg_state_roe) then
8717# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8718 rho_avg = sqrt(rho_l*rho_r)
8719# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8720
8721# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8722 vel_avg_rms = 0._wp
8723# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8724
8725# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8726
8727# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8728#if defined(MFC_OpenACC)
8729# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8730!$acc loop seq
8731# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8732#elif defined(MFC_OpenMP)
8733# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8734
8735# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8736#endif
8737# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8738 do i = 1, num_vels
8739# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8740 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
8741# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8742 end do
8743# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8744
8745# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8746 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8747# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8748
8749# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8750 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8751# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8752
8753# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8754 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
8755# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8756
8757# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8758 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8759# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8760
8761# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8762 if (chemistry) then
8763# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8764 eps = 0.001_wp
8765# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8766 call get_species_enthalpies_rt(t_l, h_il)
8767# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8768 call get_species_enthalpies_rt(t_r, h_ir)
8769# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8770 h_il = h_il*gas_constant/molecular_weights*t_l
8771# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8772 h_ir = h_ir*gas_constant/molecular_weights*t_r
8773# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8774 call get_species_specific_heats_r(t_l, cp_il)
8775# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8776 call get_species_specific_heats_r(t_r, cp_ir)
8777# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8778
8779# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8780 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8781# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8782 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8783# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8784 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8785# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8786 if (abs(t_l - t_r) < eps) then
8787# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8788 ! Case when T_L and T_R are very close
8789# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8790 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8791# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8792 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8793# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8794 & - gas_constant/molecular_weights(:)))
8795# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8796 else
8797# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8798 ! Normal calculation when T_L and T_R are sufficiently different
8799# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8800 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8801# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8802 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8803# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8804 end if
8805# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8806 gamma_avg = cp_avg/cv_avg
8807# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8808
8809# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8810 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8811# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8812 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8813# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8814 end if
8815# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8816 end if
8817# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8818
8819# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8820 if (avg_state == avg_state_arithmetic) then
8821# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8822 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8823# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8824 vel_avg_rms = 0._wp
8825# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8826
8827# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8828#if defined(MFC_OpenACC)
8829# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8830!$acc loop seq
8831# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8832#elif defined(MFC_OpenMP)
8833# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8834
8835# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8836#endif
8837# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8838 do i = 1, num_vels
8839# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8840 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8841# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8842 end do
8843# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8844
8845# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8846 h_avg = 5.e-1_wp*(h_l + h_r)
8847# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8848 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8849# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8850 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8851# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8852 end if
8853
8854 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8855 & c_l, qv_l)
8856
8857 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8858 & c_r, qv_r)
8859
8860 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8861 ! variables are placeholders to call the subroutine.
8862 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8863 & c_sum_yi_phi, c_avg, qv_avg)
8864
8865 if (viscous) then
8866 if (chemistry) then
8867 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8868 end if
8869
8870# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8871#if defined(MFC_OpenACC)
8872# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8873!$acc loop seq
8874# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8875#elif defined(MFC_OpenMP)
8876# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8877
8878# 1400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8879#endif
8880 do i = 1, 2
8881 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8882 end do
8883 end if
8884
8885 ! Low Mach correction
8886 if (low_mach == 2) then
8887 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8888# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8889 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8890# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8891 pcorr = 0._wp
8892# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8893
8894# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8895 if (low_mach == 1) then
8896# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8897 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8898# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8899 end if
8900# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8901 else if (riemann_solver == riemann_solver_hllc) then
8902# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8903 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8904# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8905 pcorr = 0._wp
8906# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8907
8908# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8909 if (low_mach == 1) then
8910# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8911 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))) &
8912# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8913 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8914# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8915 else if (low_mach == 2) then
8916# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8917 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))))
8918# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8919 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))))
8920# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8921 vel_l(dir_idx(1)) = vel_l_tmp
8922# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8923 vel_r(dir_idx(1)) = vel_r_tmp
8924# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8925 end if
8926# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8927 end if
8928 end if
8929
8930 if (wave_speeds == wave_speeds_direct) then
8931 if (elasticity) then
8932 ! Elastic wave speed, Rodriguez et al. JCP (2019)
8933 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) &
8934 & ))/rho_l), &
8935 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
8936 & + tau_e_r(dir_idx_tau(1)))/rho_r))
8937 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) &
8938 & ))/rho_r), &
8939 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
8940 & + tau_e_l(dir_idx_tau(1)))/rho_l))
8941 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
8942 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
8943 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
8944 & - vel_r(dir_idx(1))))
8945 else
8946 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8947 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8948 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8949 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
8950 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
8951 end if
8952 else if (wave_speeds == wave_speeds_pressure) then
8953 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8954
8955 pres_sr = pres_sl
8956
8957 ! Low Mach correction: Thornber et al. JCP (2008)
8958 ms_l = max(1._wp, &
8959 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8960 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8961 ms_r = max(1._wp, &
8962 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8963 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8964
8965 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8966 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8967
8968 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8969 end if
8970
8971 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8972 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8973
8974 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8975 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8976 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8977 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
8978 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8979 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8980
8981 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8982 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8983 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8984
8985 ! Low Mach correction
8986 if (low_mach == 1) then
8987 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8988# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8989 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8990# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8991 pcorr = 0._wp
8992# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8993
8994# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8995 if (low_mach == 1) then
8996# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8997 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8998# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8999 end if
9000# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9001 else if (riemann_solver == riemann_solver_hllc) then
9002# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9003 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9004# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9005 pcorr = 0._wp
9006# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9007
9008# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9009 if (low_mach == 1) then
9010# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9011 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))) &
9012# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9013 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9014# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9015 else if (low_mach == 2) then
9016# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9017 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))))
9018# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9019 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))))
9020# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9021 vel_l(dir_idx(1)) = vel_l_tmp
9022# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9023 vel_r(dir_idx(1)) = vel_r_tmp
9024# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9025 end if
9026# 1468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9027 end if
9028 else
9029 pcorr = 0._wp
9030 end if
9031
9032 ! COMPUTING THE HLLC FLUXES MASS FLUX.
9033
9034# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9035#if defined(MFC_OpenACC)
9036# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9037!$acc loop seq
9038# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9039#elif defined(MFC_OpenMP)
9040# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9041
9042# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9043#endif
9044 do i = 1, eqn_idx%cont%end
9045 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9046 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
9047 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9048 end do
9049
9050 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
9051 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
9052
9053# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9054#if defined(MFC_OpenACC)
9055# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9056!$acc loop seq
9057# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9058#elif defined(MFC_OpenMP)
9059# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9060
9061# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9062#endif
9063 do i = 1, num_dims
9064 flux_rsx_vf(j, k, l, &
9065 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
9066 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
9067 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
9068 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
9069 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
9070 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9071 end do
9072
9073 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9074 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
9075 flux_rsx_vf(j, k, l, &
9076 & 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 &
9077 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
9078 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
9079 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
9080 & *(s_p/s_r)*pcorr*s_s
9081
9082 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
9083 if (elasticity) then
9084 flux_ene_e = 0._wp
9085
9086# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9087#if defined(MFC_OpenACC)
9088# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9089!$acc loop seq
9090# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9091#elif defined(MFC_OpenMP)
9092# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9093
9094# 1506 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9095#endif
9096 do i = 1, num_dims
9097 ! MOMENTUM ELASTIC FLUX.
9098 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
9099 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
9100 & - xi_p*tau_e_r(dir_idx_tau(i))
9101 ! ENERGY ELASTIC FLUX.
9102 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
9103 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
9104 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
9105 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
9106 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
9107 end do
9108 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
9109 end if
9110
9111 ! HYPOELASTIC STRESS EVOLUTION FLUX.
9112 if (hypoelasticity) then
9113
9114# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9115#if defined(MFC_OpenACC)
9116# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9117!$acc loop seq
9118# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9119#elif defined(MFC_OpenMP)
9120# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9121
9122# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9123#endif
9124 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9125 flux_rsx_vf(j, k, l, &
9126 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
9127 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9128 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
9129 end do
9130 end if
9131
9132 ! VOLUME FRACTION FLUX.
9133
9134# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9135#if defined(MFC_OpenACC)
9136# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9137!$acc loop seq
9138# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9139#elif defined(MFC_OpenMP)
9140# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9141
9142# 1534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9143#endif
9144 do i = eqn_idx%adv%beg, eqn_idx%adv%end
9145 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9146 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
9147 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9148 end do
9149
9150 ! VOLUME FRACTION SOURCE FLUX.
9151
9152# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9153#if defined(MFC_OpenACC)
9154# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9155!$acc loop seq
9156# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9157#elif defined(MFC_OpenMP)
9158# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9159
9160# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9161#endif
9162 do i = 1, num_dims
9163 vel_src_rsx_vf(j, k, l, &
9164 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
9165 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
9166 end do
9167
9168 ! COLOR FUNCTION FLUX
9169 if (surface_tension) then
9170 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
9171 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9172 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9173 end if
9174
9175 ! Hyperelastic reference map flux for material deformation tracking
9176 if (hyperelasticity) then
9177
9178# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9179#if defined(MFC_OpenACC)
9180# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9181!$acc loop seq
9182# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9183#elif defined(MFC_OpenMP)
9184# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9185
9186# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9187#endif
9188 do i = 1, num_dims
9189 flux_rsx_vf(j, k, l, &
9190 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
9191 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9192 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
9193 end do
9194 end if
9195
9196 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9197
9198 if (chemistry) then
9199
9200# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9201#if defined(MFC_OpenACC)
9202# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9203!$acc loop seq
9204# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9205#elif defined(MFC_OpenMP)
9206# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9207
9208# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9209#endif
9210 do i = eqn_idx%species%beg, eqn_idx%species%end
9211 y_l = ql_prim_rsx_vf(j, k, l, i)
9212 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
9213
9214 flux_rsx_vf(j, k, l, &
9215 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9216 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9217 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9218 end do
9219 end if
9220
9221 ! Geometrical source flux for cylindrical coordinates
9222# 1605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9223# 1606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9224 if (grid_geometry == 3) then
9225
9226# 1607 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9227#if defined(MFC_OpenACC)
9228# 1607 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9229!$acc loop seq
9230# 1607 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9231#elif defined(MFC_OpenMP)
9232# 1607 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9233
9234# 1607 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9235#endif
9236 do i = 1, sys_size
9237 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
9238 end do
9239
9240 flux_gsrc_rsx_vf(j, k, l, &
9241 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
9242 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
9243 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
9244 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
9245 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
9246 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
9247 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
9248 end if
9249# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9250 end do
9251 end do
9252 end do
9253
9254# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9255#if defined(MFC_OpenACC)
9256# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9257!$acc end parallel loop
9258# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9259#elif defined(MFC_OpenMP)
9260# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9261
9262# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9263!$omp end target teams loop
9264# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9265#endif
9266 end if
9267 end if
9268# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
9269 ! Computing HLLC flux and source flux for Euler system of equations
9270
9271 if (viscous) then
9272 if (weno_re_flux) then
9273 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9274 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9275 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9276 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9277 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9278 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9279 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9280 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
9281 & norm_dir, ix, iy, iz)
9282 else
9283 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9284 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9285 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9286 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9287 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9288 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9289 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
9290 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
9291 & norm_dir, ix, iy, iz)
9292 end if
9293 end if
9294
9295 if (surface_tension) then
9296 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
9297 end if
9298
9299 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
9300
9301 end subroutine s_hllc_riemann_solver
9302
9303end module m_riemann_solver_hllc
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:323
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:360
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:360
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:360
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged models.
Definition m_bubbles.fpp.f90:323
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:622
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:335
m_chemistry::compute_viscosity_and_inversion
subroutine compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l, re_r)
Compute mixture viscosities for left and right states and invert them for use as reciprocal Reynolds ...
Definition m_chemistry.fpp.f90:375
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:323
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:334
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:603
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:378
m_global_parameters::re_idx
integer, dimension(:,:), allocatable re_idx
Definition m_global_parameters.fpp.f90:605
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:772
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:662
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:664
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:773
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:918
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:918
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:663
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:756
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:918
m_riemann_solver_hllc
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solver_hllc.fpp.f90:343
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:367
m_riemann_state
Shared Riemann-solver module state and the per-sweep setup, state-buffer population,...
Definition m_riemann_state.fpp.f90:335
m_riemann_state::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_state.fpp.f90:348
m_riemann_state::isz
type(int_bounds_info) isz
Definition m_riemann_state.fpp.f90:423
m_riemann_state::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_state.fpp.f90:394
m_riemann_state::isx
type(int_bounds_info) isx
Definition m_riemann_state.fpp.f90:423
m_riemann_state::is3
type(int_bounds_info) is3
Definition m_riemann_state.fpp.f90:422
m_riemann_state::flux_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_rsx_vf
The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann pr...
Definition m_riemann_state.fpp.f90:348
m_riemann_state::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_state.fpp.f90:451
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:1569
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:471
m_riemann_state::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_state.fpp.f90:438
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:493
m_riemann_state::isy
type(int_bounds_info) isy
Definition m_riemann_state.fpp.f90:423
m_riemann_state::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_state.fpp.f90:381
m_riemann_state::is2
type(int_bounds_info) is2
Definition m_riemann_state.fpp.f90:422
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:2534
m_riemann_state::flux_gsrc_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_gsrc_rsx_vf
The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann ...
Definition m_riemann_state.fpp.f90:365
m_riemann_state::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_state.fpp.f90:407
m_riemann_state::is1
type(int_bounds_info) is1
Definition m_riemann_state.fpp.f90:422
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:337
m_surface_tension::s_compute_capillary_source_flux
subroutine, public s_compute_capillary_source_flux(vsrc_rsx_vf, flux_src_vf, id, isx, isy, isz)
Compute the capillary source flux from reconstructed color-gradient fields.
Definition m_surface_tension.fpp.f90:601
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_variables_conversion::s_compute_speed_of_sound
subroutine 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:2603
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:417
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:337