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.
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# 52 "/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 !> Post-limiter volume fractions (alpha_L/R retain the pre-limiter loads used downstream)
383 real(wp), dimension(num_fluids) :: alpha_lim_L, alpha_lim_R
384 real(wp), dimension(num_dims) :: vel_L, vel_R
385# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
386
387 real(wp) :: rho_L, rho_R
388 real(wp) :: pres_L, pres_R
389 real(wp) :: E_L, E_R
390 real(wp) :: H_L, H_R
391# 67 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
392 real(wp), dimension(num_species) :: Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR
393 real(wp), dimension(num_species) :: Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2
394# 70 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
395 real(wp) :: Cp_avg, Cv_avg, T_avg, c_sum_Yi_Phi, eps
396 real(wp) :: T_L, T_R
397 real(wp) :: MW_L, MW_R
398 real(wp) :: R_gas_L, R_gas_R
399 real(wp) :: Cp_L, Cp_R
400 real(wp) :: Cv_L, Cv_R
401 real(wp) :: Gamm_L, Gamm_R
402 real(wp) :: Y_L, Y_R
403 real(wp) :: gamma_L, gamma_R
404 real(wp) :: pi_inf_L, pi_inf_R
405 real(wp) :: qv_L, qv_R
406 real(wp) :: c_L, c_R
407 real(wp), dimension(2) :: Re_L, Re_R
408 real(wp) :: rho_avg
409 real(wp) :: H_avg
410 real(wp) :: gamma_avg
411 real(wp) :: qv_avg
412 real(wp) :: c_avg
413 real(wp) :: s_L, s_R, s_M, s_P, s_S
414 real(wp) :: xi_L, xi_R !< Left and right wave speeds functions
415 real(wp) :: xi_L_m1, xi_R_m1 !< xi_L/R - 1, computed without cancellation
416 real(wp) :: xi_M, xi_P
417 real(wp) :: xi_MP, xi_PP
418# 99 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
419 real(wp), dimension(nb) :: R0_L, R0_R
420 real(wp), dimension(nb) :: V0_L, V0_R
421 real(wp), dimension(nb) :: P0_L, P0_R
422 real(wp), dimension(nb) :: pbw_L, pbw_R
423# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
424
425 real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L, nbub_R
426 real(wp) :: ptilde_L, ptilde_R
427 real(wp) :: PbwR3Lbar, PbwR3Rbar
428 real(wp) :: R3Lbar, R3Rbar
429 real(wp) :: R3V2Lbar, R3V2Rbar
430 real(wp), dimension(6) :: tau_e_L, tau_e_R
431# 114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
432 real(wp), dimension(num_dims) :: xi_field_L, xi_field_R
433# 116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
434 real(wp) :: G_L, G_R
435 real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms
436 real(wp) :: vel_L_tmp, vel_R_tmp
437 real(wp) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_star
438 real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R
439 real(wp) :: flux_ene_e
440 real(wp) :: zcoef, pcorr !< low Mach number correction
441 integer :: i, j, k, l, q !< Generic loop iterators
442 integer :: Re_size_loc1, Re_size_loc2 !< host copies of Re_size; amdflang reads the declare-target original stale cross-TU
443 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
444
445 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
446 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
447
448 ! Reshaping inputted data based on dimensional splitting direction
449
450 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
451
452 re_size_loc1 = re_size(1); re_size_loc2 = re_size(2)
453
454# 140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
455# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
456# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
457 if (norm_dir == 1) then
458 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
459 if (model_eqns == model_eqns_6eq) then
460 ! 6-equation model (model_eqns=3): separate phasic internal energies
461
462# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
463
464# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
465#if defined(MFC_OpenACC)
466# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
467!$acc parallel loop collapse(3) gang vector default(present) &
468# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
469!$acc& private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, 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) &
470# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
471!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
472# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
473#elif defined(MFC_OpenMP)
474# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
475
476# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
477
478# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
479
480# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
481!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
482# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
483!$omp& private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, 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) &
484# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
485!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
486# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
487#endif
488# 157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
489 do l = is3%beg, is3%end
490 do k = is2%beg, is2%end
491 do j = is1%beg, is1%end
492 vel_l_rms = 0._wp; vel_r_rms = 0._wp
493 rho_l = 0._wp; rho_r = 0._wp
494 gamma_l = 0._wp; gamma_r = 0._wp
495 pi_inf_l = 0._wp; pi_inf_r = 0._wp
496 qv_l = 0._wp; qv_r = 0._wp
497 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
498
499
500# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
501#if defined(MFC_OpenACC)
502# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
503!$acc loop seq
504# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
505#elif defined(MFC_OpenMP)
506# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
507
508# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
509#endif
510 do i = 1, num_dims
511 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
512 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
513 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
514 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
515 end do
516
517 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
518 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
519
520 rho_l = 0._wp
521 gamma_l = 0._wp
522 pi_inf_l = 0._wp
523 qv_l = 0._wp
524
525 rho_r = 0._wp
526 gamma_r = 0._wp
527 pi_inf_r = 0._wp
528 qv_r = 0._wp
529
530 alpha_l_sum = 0._wp
531 alpha_r_sum = 0._wp
532
533 if (mpp_lim) then
534
535# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
536#if defined(MFC_OpenACC)
537# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
538!$acc loop seq
539# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
540#elif defined(MFC_OpenMP)
541# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
542
543# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
544#endif
545 do i = 1, num_fluids
546 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
547 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
548 & eqn_idx%E + i)), 1._wp)
549 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
550 end do
551
552
553# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
554#if defined(MFC_OpenACC)
555# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
556!$acc loop seq
557# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
558#elif defined(MFC_OpenMP)
559# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
560
561# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
562#endif
563 do i = 1, num_fluids
564 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
565 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
566 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
567 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
568 end do
569
570
571# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
572#if defined(MFC_OpenACC)
573# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
574!$acc loop seq
575# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
576#elif defined(MFC_OpenMP)
577# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
578
579# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
580#endif
581 do i = 1, num_fluids
582 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
583 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
584 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
585 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
586 end do
587 end if
588
589
590# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
591#if defined(MFC_OpenACC)
592# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
593!$acc loop seq
594# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
595#elif defined(MFC_OpenMP)
596# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
597
598# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
599#endif
600 do i = 1, num_fluids
601 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
602 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
603 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
604 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
605 end do
606
607 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
608 & qv_l)
609 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
610 & qv_r)
611
612 if (viscous) then
613 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
614 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
615 end if
616
617 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
618 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
619
620 ! Hyperelastic stress contribution: strain energy added to total energy
621 if (hyperelasticity) then
622
623# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
624#if defined(MFC_OpenACC)
625# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
626!$acc loop seq
627# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
628#elif defined(MFC_OpenMP)
629# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
630
631# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
632#endif
633 do i = 1, num_dims
634 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
635 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
636 end do
637 g_l = 0._wp; g_r = 0._wp
638
639# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
640#if defined(MFC_OpenACC)
641# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
642!$acc loop seq
643# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
644#elif defined(MFC_OpenMP)
645# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
646
647# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
648#endif
649 do i = 1, num_fluids
650 ! Mixture left and right shear modulus
651 g_l = g_l + alpha_l(i)*gs_rs(i)
652 g_r = g_r + alpha_r(i)*gs_rs(i)
653 end do
654 ! Elastic contribution to energy if G large enough
655 if (g_l > verysmall .and. g_r > verysmall) then
656 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
657 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
658 end if
659
660# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
661#if defined(MFC_OpenACC)
662# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
663!$acc loop seq
664# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
665#elif defined(MFC_OpenMP)
666# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
667
668# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
669#endif
670 do i = 1, b_size - 1
671 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
672 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
673 end do
674 end if
675
676 h_l = (e_l + pres_l)/rho_l
677 h_r = (e_r + pres_r)/rho_r
678
679 if (avg_state == avg_state_roe) then
680# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
681 rho_avg = sqrt(rho_l*rho_r)
682# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
683
684# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
685 vel_avg_rms = 0._wp
686# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
687
688# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
689
690# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
691#if defined(MFC_OpenACC)
692# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
693!$acc loop seq
694# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
695#elif defined(MFC_OpenMP)
696# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
697
698# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
699#endif
700# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
701 do i = 1, num_vels
702# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
703 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
704# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
705 end do
706# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
707
708# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
709 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
710# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
711
712# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
713 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
714# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
715
716# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
717 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
718# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
719
720# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
721 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
722# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
723
724# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
725 if (chemistry) then
726# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
727 eps = 0.001_wp
728# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
729 call get_species_enthalpies_rt(t_l, h_il)
730# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
731 call get_species_enthalpies_rt(t_r, h_ir)
732# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
733 h_il = h_il*gas_constant/molecular_weights*t_l
734# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
735 h_ir = h_ir*gas_constant/molecular_weights*t_r
736# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
737 call get_species_specific_heats_r(t_l, cp_il)
738# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
739 call get_species_specific_heats_r(t_r, cp_ir)
740# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
741
742# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
743 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
744# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
745 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
746# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
747 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
748# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
749 if (abs(t_l - t_r) < eps) then
750# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
751 ! Case when T_L and T_R are very close
752# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
753 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
754# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
755 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
756# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
757 & - gas_constant/molecular_weights(:)))
758# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
759 else
760# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
761 ! Normal calculation when T_L and T_R are sufficiently different
762# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
763 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
764# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
765 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
766# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
767 end if
768# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
769 gamma_avg = cp_avg/cv_avg
770# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
771
772# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
773 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
774# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
775 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
776# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
777 end if
778# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
779 end if
780# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
781
782# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
783 if (avg_state == avg_state_arithmetic) then
784# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
785 rho_avg = 5.e-1_wp*(rho_l + rho_r)
786# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
787 vel_avg_rms = 0._wp
788# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
789
790# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
791#if defined(MFC_OpenACC)
792# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
793!$acc loop seq
794# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
795#elif defined(MFC_OpenMP)
796# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
797
798# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
799#endif
800# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
801 do i = 1, num_vels
802# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
803 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
804# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
805 end do
806# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
807
808# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
809 h_avg = 5.e-1_wp*(h_l + h_r)
810# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
811 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
812# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
813 qv_avg = 5.e-1_wp*(qv_l + qv_r)
814# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
815 end if
816
817 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
818 & c_l, qv_l)
819
820 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
821 & c_r, qv_r)
822
823 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
824 ! variables are placeholders to call the subroutine.
825 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
826 & 0._wp, c_avg, qv_avg)
827
828 if (viscous) then
829
830# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
831#if defined(MFC_OpenACC)
832# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
833!$acc loop seq
834# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
835#elif defined(MFC_OpenMP)
836# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
837
838# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
839#endif
840 do i = 1, 2
841 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
842 end do
843 end if
844
845 ! Low Mach correction
846 if (low_mach == 2) then
847 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
848# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
849 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
850# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
851 pcorr = 0._wp
852# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
853
854# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
855 if (low_mach == 1) then
856# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
857 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
858# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
859 end if
860# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
861 else if (riemann_solver == riemann_solver_hllc) then
862# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
863 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
864# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
865 pcorr = 0._wp
866# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
867
868# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
869 if (low_mach == 1) then
870# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
871 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))) &
872# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
873 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
874# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
875 else if (low_mach == 2) then
876# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
877 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))))
878# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
879 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))))
880# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
881 vel_l(dir_idx(1)) = vel_l_tmp
882# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
883 vel_r(dir_idx(1)) = vel_r_tmp
884# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
885 end if
886# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
887 end if
888 end if
889
890 ! COMPUTING THE DIRECT WAVE SPEEDS
891 if (wave_speeds == wave_speeds_direct) then
892 if (elasticity) then
893 ! Elastic wave speed, Rodriguez et al. JCP (2019)
894 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) &
895 & ))/rho_l), &
896 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
897 & + tau_e_r(dir_idx_tau(1)))/rho_r))
898 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) &
899 & ))/rho_r), &
900 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
901 & + tau_e_l(dir_idx_tau(1)))/rho_l))
902 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
903 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
904 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
905 & - vel_r(dir_idx(1))))
906 else
907 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
908 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
909 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
910 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
911 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
912 end if
913 else if (wave_speeds == wave_speeds_pressure) then
914 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
915
916 pres_sr = pres_sl
917
918 ! Low Mach correction: Thornber et al. JCP (2008)
919 ms_l = max(1._wp, &
920 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
921 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
922 ms_r = max(1._wp, &
923 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
924 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
925
926 s_l = vel_l(dir_idx(1)) - c_l*ms_l
927 s_r = vel_r(dir_idx(1)) + c_r*ms_r
928
929 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
930 end if
931
932 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
933 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
934
935 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
936 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
937 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
938 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
939 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
940
941 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
942 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
943 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
944
945 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
946 xi_mp = -min(0._wp, sign(1._wp, s_l))
947 xi_pp = max(0._wp, sign(1._wp, s_r))
948
949 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 &
950 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
951 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
952 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
953 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
954
955 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))
956
957 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 &
958 & - vel_r(dir_idx(1)))
959
960 ! Low Mach correction
961 if (low_mach == 1) then
962 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
963# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
964 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
965# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
966 pcorr = 0._wp
967# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
968
969# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
970 if (low_mach == 1) then
971# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
972 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
973# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
974 end if
975# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
976 else if (riemann_solver == riemann_solver_hllc) then
977# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
978 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
979# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
980 pcorr = 0._wp
981# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
982
983# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
984 if (low_mach == 1) then
985# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
986 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))) &
987# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
988 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
989# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
990 else if (low_mach == 2) then
991# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
992 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))))
993# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
994 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))))
995# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
996 vel_l(dir_idx(1)) = vel_l_tmp
997# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
998 vel_r(dir_idx(1)) = vel_r_tmp
999# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1000 end if
1001# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1002 end if
1003 else
1004 pcorr = 0._wp
1005 end if
1006
1007 ! COMPUTING FLUXES MASS FLUX.
1008
1009# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1010#if defined(MFC_OpenACC)
1011# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1012!$acc loop seq
1013# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1014#elif defined(MFC_OpenMP)
1015# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1016
1017# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1018#endif
1019 do i = 1, eqn_idx%cont%end
1020 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1021 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1022 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1023 end do
1024
1025 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1026
1027# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1028#if defined(MFC_OpenACC)
1029# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1030!$acc loop seq
1031# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1032#elif defined(MFC_OpenMP)
1033# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1034
1035# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1036#endif
1037 do i = 1, num_dims
1038 flux_rsx_vf(j, k, l, &
1039 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
1040 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
1041 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
1042 & *dir_flg(dir_idx(i))*pcorr
1043 end do
1044
1045 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
1046 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
1047
1048 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
1049 if (elasticity) then
1050 flux_ene_e = 0._wp
1051
1052# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1053#if defined(MFC_OpenACC)
1054# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1055!$acc loop seq
1056# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1057#elif defined(MFC_OpenMP)
1058# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1059
1060# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1061#endif
1062 do i = 1, num_dims
1063 ! MOMENTUM ELASTIC FLUX.
1064 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
1065 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
1066 & - xi_p*tau_e_r(dir_idx_tau(i))
1067 ! ENERGY ELASTIC FLUX.
1068 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
1069 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
1070 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
1071 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
1072 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
1073 end do
1074 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
1075 end if
1076
1077 ! VOLUME FRACTION FLUX.
1078
1079# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1080#if defined(MFC_OpenACC)
1081# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1082!$acc loop seq
1083# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1084#elif defined(MFC_OpenMP)
1085# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1086
1087# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1088#endif
1089 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1090 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1091 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
1092 end do
1093
1094 ! Advection velocity source: interface velocity for volume fraction transport
1095
1096# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1097#if defined(MFC_OpenACC)
1098# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1099!$acc loop seq
1100# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1101#elif defined(MFC_OpenMP)
1102# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1103
1104# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1105#endif
1106 do i = 1, num_dims
1107 vel_src_rsx_vf(j, k, l, &
1108 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1109 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
1110 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
1111 end do
1112
1113 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
1114 ! energy flux
1115
1116# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1117#if defined(MFC_OpenACC)
1118# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1119!$acc loop seq
1120# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1121#elif defined(MFC_OpenMP)
1122# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1123
1124# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1125#endif
1126 do i = 1, num_fluids
1127 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
1128 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
1129 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
1130 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
1131 & + pres_r)
1132
1133 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
1134 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1135 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
1136 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
1137 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1138 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
1139 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
1140 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1141 & i + eqn_idx%adv%beg - 1))
1142 end do
1143
1144 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1145
1146 ! Hyperelastic reference map flux for material deformation tracking
1147 if (hyperelasticity) then
1148
1149# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1150#if defined(MFC_OpenACC)
1151# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1152!$acc loop seq
1153# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1154#elif defined(MFC_OpenMP)
1155# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1156
1157# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1158#endif
1159 do i = 1, num_dims
1160 flux_rsx_vf(j, k, l, &
1161 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
1162 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
1163 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
1164 end do
1165 end if
1166
1167 ! COLOR FUNCTION FLUX
1168 if (surface_tension) then
1169 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
1170 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
1171 end if
1172
1173 ! Geometrical source flux for cylindrical coordinates
1174# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1175# 501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1176 end do
1177 end do
1178 end do
1179
1180# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1181#if defined(MFC_OpenACC)
1182# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1183!$acc end parallel loop
1184# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1185#elif defined(MFC_OpenMP)
1186# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1187
1188# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1189!$omp end target teams loop
1190# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1191#endif
1192 else if (model_eqns == model_eqns_4eq) then
1193 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
1194
1195# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1196
1197# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1198#if defined(MFC_OpenACC)
1199# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1200!$acc parallel loop collapse(3) gang vector default(present) &
1201# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1202!$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)
1203# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1204#elif defined(MFC_OpenMP)
1205# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1206
1207# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1208
1209# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1210
1211# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1212!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1213# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1214!$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)
1215# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1216#endif
1217# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1218 do l = is3%beg, is3%end
1219 do k = is2%beg, is2%end
1220 do j = is1%beg, is1%end
1221 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1222 rho_l = 0._wp; rho_r = 0._wp
1223 gamma_l = 0._wp; gamma_r = 0._wp
1224 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1225 qv_l = 0._wp; qv_r = 0._wp
1226
1227
1228# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1229#if defined(MFC_OpenACC)
1230# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1231!$acc loop seq
1232# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1233#elif defined(MFC_OpenMP)
1234# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1235
1236# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1237#endif
1238 do i = 1, eqn_idx%cont%end
1239 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1240 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1241 end do
1242
1243
1244# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1245#if defined(MFC_OpenACC)
1246# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1247!$acc loop seq
1248# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1249#elif defined(MFC_OpenMP)
1250# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1251
1252# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1253#endif
1254 do i = 1, num_dims
1255 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1256 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1257 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1258 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1259 end do
1260
1261
1262# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1263#if defined(MFC_OpenACC)
1264# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1265!$acc loop seq
1266# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1267#elif defined(MFC_OpenMP)
1268# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1269
1270# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1271#endif
1272 do i = 1, num_fluids
1273 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1274 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1275 end do
1276
1277# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1278#if defined(MFC_OpenACC)
1279# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1280!$acc loop seq
1281# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1282#elif defined(MFC_OpenMP)
1283# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1284
1285# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1286#endif
1287 do i = 1, num_fluids
1288 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1289 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1290 end do
1291
1292 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
1293 & qv_l)
1294 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
1295 & qv_r)
1296
1297 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1298 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1299
1300 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
1301 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
1302
1303 h_l = (e_l + pres_l)/rho_l
1304 h_r = (e_r + pres_r)/rho_r
1305
1306 if (avg_state == avg_state_roe) then
1307# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1308 rho_avg = sqrt(rho_l*rho_r)
1309# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1310
1311# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1312 vel_avg_rms = 0._wp
1313# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1314
1315# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1316
1317# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1318#if defined(MFC_OpenACC)
1319# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1320!$acc loop seq
1321# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1322#elif defined(MFC_OpenMP)
1323# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1324
1325# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1326#endif
1327# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1328 do i = 1, num_vels
1329# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1330 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
1331# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1332 end do
1333# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1334
1335# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1336 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1337# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1338
1339# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1340 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1341# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1342
1343# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1344 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
1345# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1346
1347# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1348 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1349# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1350
1351# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1352 if (chemistry) then
1353# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1354 eps = 0.001_wp
1355# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1356 call get_species_enthalpies_rt(t_l, h_il)
1357# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1358 call get_species_enthalpies_rt(t_r, h_ir)
1359# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1360 h_il = h_il*gas_constant/molecular_weights*t_l
1361# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1362 h_ir = h_ir*gas_constant/molecular_weights*t_r
1363# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1364 call get_species_specific_heats_r(t_l, cp_il)
1365# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1366 call get_species_specific_heats_r(t_r, cp_ir)
1367# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1368
1369# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1370 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1371# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1372 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1373# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1374 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1375# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1376 if (abs(t_l - t_r) < eps) then
1377# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1378 ! Case when T_L and T_R are very close
1379# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1380 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1381# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1382 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
1383# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1384 & - gas_constant/molecular_weights(:)))
1385# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1386 else
1387# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1388 ! Normal calculation when T_L and T_R are sufficiently different
1389# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1390 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1391# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1392 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1393# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1394 end if
1395# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1396 gamma_avg = cp_avg/cv_avg
1397# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1398
1399# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1400 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1401# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1402 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1403# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1404 end if
1405# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1406 end if
1407# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1408
1409# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1410 if (avg_state == avg_state_arithmetic) then
1411# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1412 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1413# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1414 vel_avg_rms = 0._wp
1415# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1416
1417# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1418#if defined(MFC_OpenACC)
1419# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1420!$acc loop seq
1421# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1422#elif defined(MFC_OpenMP)
1423# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1424
1425# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1426#endif
1427# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1428 do i = 1, num_vels
1429# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1430 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1431# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1432 end do
1433# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1434
1435# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1436 h_avg = 5.e-1_wp*(h_l + h_r)
1437# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1438 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1439# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1440 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1441# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1442 end if
1443
1444 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
1445 & c_l, qv_l)
1446
1447 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
1448 & c_r, qv_r)
1449
1450 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1451 ! variables are placeholders to call the subroutine.
1452
1453 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1454 & 0._wp, c_avg, qv_avg)
1455
1456 if (wave_speeds == wave_speeds_direct) then
1457 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1458 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1459
1460 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1461 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1462 & - rho_r*(s_r - vel_r(dir_idx(1))))
1463 else if (wave_speeds == wave_speeds_pressure) then
1464 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1465
1466 pres_sr = pres_sl
1467
1468 ! Low Mach correction: Thornber et al. JCP (2008)
1469 ms_l = max(1._wp, &
1470 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1471 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1472 ms_r = max(1._wp, &
1473 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1474 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1475
1476 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1477 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1478
1479 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1480 end if
1481
1482 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
1483 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1484
1485 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
1486 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1487 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1488 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
1489 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
1490
1491 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
1492 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
1493 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
1494
1495
1496# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1497#if defined(MFC_OpenACC)
1498# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1499!$acc loop seq
1500# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1501#elif defined(MFC_OpenMP)
1502# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1503
1504# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1505#endif
1506 do i = 1, eqn_idx%cont%end
1507 flux_rsx_vf(j, k, l, &
1508 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
1509 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1510 end do
1511
1512 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
1513
1514# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1515#if defined(MFC_OpenACC)
1516# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1517!$acc loop seq
1518# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1519#elif defined(MFC_OpenMP)
1520# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1521
1522# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1523#endif
1524 do i = 1, num_dims
1525 flux_rsx_vf(j, k, l, &
1526 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
1527 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1528 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
1529 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1530 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
1531 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
1532 end do
1533
1534 if (bubbles_euler) then
1535 ! Put p_tilde in
1536
1537# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1538#if defined(MFC_OpenACC)
1539# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1540!$acc loop seq
1541# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1542#elif defined(MFC_OpenMP)
1543# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1544
1545# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1546#endif
1547 do i = 1, num_dims
1548 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
1549 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
1550 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
1551 end do
1552 end if
1553
1554 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
1555
1556
1557# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1558#if defined(MFC_OpenACC)
1559# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1560!$acc loop seq
1561# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1562#elif defined(MFC_OpenMP)
1563# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1564
1565# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1566#endif
1567 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
1568 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
1569 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
1570 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1571 end do
1572
1573 ! Advection velocity source: interface velocity for volume fraction transport
1574
1575# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1576#if defined(MFC_OpenACC)
1577# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1578!$acc loop seq
1579# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1580#elif defined(MFC_OpenMP)
1581# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1582
1583# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1584#endif
1585 do i = 1, num_dims
1586 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
1587 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
1588 end do
1589
1590 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
1591
1592 ! Add advection flux for bubble variables
1593 if (bubbles_euler) then
1594
1595# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1596#if defined(MFC_OpenACC)
1597# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1598!$acc loop seq
1599# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1600#elif defined(MFC_OpenMP)
1601# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1602
1603# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1604#endif
1605 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1606 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
1607 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
1608 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
1609 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
1610 end do
1611 end if
1612
1613 ! Geometrical source flux for cylindrical coordinates
1614
1615# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1616# 710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1617 end do
1618 end do
1619 end do
1620
1621# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1622#if defined(MFC_OpenACC)
1623# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1624!$acc end parallel loop
1625# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1626#elif defined(MFC_OpenMP)
1627# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1628
1629# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1630!$omp end target teams loop
1631# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1632#endif
1633 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
1634 ! 5-equation model with Euler-Euler bubble dynamics
1635
1636# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1637
1638# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1639#if defined(MFC_OpenACC)
1640# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1641!$acc parallel loop collapse(3) gang vector default(present) &
1642# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1643!$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, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, 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) &
1644# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1645!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
1646# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1647#elif defined(MFC_OpenMP)
1648# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1649
1650# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1651
1652# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1653
1654# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1655!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1656# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1657!$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, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, 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) &
1658# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1659!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
1660# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1661#endif
1662# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1663 do l = is3%beg, is3%end
1664 do k = is2%beg, is2%end
1665 do j = is1%beg, is1%end
1666 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1667 rho_l = 0._wp; rho_r = 0._wp
1668 gamma_l = 0._wp; gamma_r = 0._wp
1669 pi_inf_l = 0._wp; pi_inf_r = 0._wp
1670 qv_l = 0._wp; qv_r = 0._wp
1671
1672
1673# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1674#if defined(MFC_OpenACC)
1675# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1676!$acc loop seq
1677# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1678#elif defined(MFC_OpenMP)
1679# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1680
1681# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1682#endif
1683 do i = 1, num_fluids
1684 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1685 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
1686 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1687 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
1688 end do
1689
1690 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1691
1692
1693# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1694#if defined(MFC_OpenACC)
1695# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1696!$acc loop seq
1697# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1698#elif defined(MFC_OpenMP)
1699# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1700
1701# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1702#endif
1703 do i = 1, num_dims
1704 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1705 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
1706 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1707 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1708 end do
1709
1710 ! Retain this in the refactor
1711 if (mpp_lim .and. (num_fluids > 2)) then
1712 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, &
1713 & pi_inf_l, qv_l)
1714 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, &
1715 & pi_inf_r, qv_r)
1716 else if (num_fluids > 2) then
1717 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_l, alpha_l, rho_l, gamma_l, &
1718 & pi_inf_l, qv_l)
1719 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_r, alpha_r, rho_r, gamma_r, &
1720 & pi_inf_r, qv_r)
1721 else
1722 rho_l = ql_prim_rsx_vf(j, k, l, 1)
1723 gamma_l = gammas(1)
1724 pi_inf_l = pi_infs(1)
1725 qv_l = qvs(1)
1726 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
1727 gamma_r = gammas(1)
1728 pi_inf_r = pi_infs(1)
1729 qv_r = qvs(1)
1730 end if
1731
1732 if (viscous) then
1733 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
1734
1735# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1736#if defined(MFC_OpenACC)
1737# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1738!$acc loop seq
1739# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1740#elif defined(MFC_OpenMP)
1741# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1742
1743# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1744#endif
1745 do i = 1, 2
1746 re_l(i) = dflt_real
1747 re_r(i) = dflt_real
1748
1749 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
1750 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
1751
1752
1753# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1754#if defined(MFC_OpenACC)
1755# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1756!$acc loop seq
1757# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1758#elif defined(MFC_OpenMP)
1759# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1760
1761# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1762#endif
1763 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
1764 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
1765 & q)))/res_gs(i, q) + re_l(i)
1766 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
1767 & q)))/res_gs(i, q) + re_r(i)
1768 end do
1769
1770 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1771 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1772 end do
1773 end if
1774 end if
1775
1776 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1777 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
1778
1779 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
1780 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
1781
1782 h_l = (e_l + pres_l)/rho_l
1783 h_r = (e_r + pres_r)/rho_r
1784
1785 if (avg_state == avg_state_arithmetic) then
1786
1787# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1788#if defined(MFC_OpenACC)
1789# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1790!$acc loop seq
1791# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1792#elif defined(MFC_OpenMP)
1793# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1794
1795# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1796#endif
1797 do i = 1, nb
1798 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
1799 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
1800
1801 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
1802 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
1803 if (.not. polytropic .and. .not. qbmm) then
1804 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
1805 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
1806 end if
1807 end do
1808
1809 if (.not. qbmm) then
1810 if (adv_n) then
1811 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
1812 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
1813 else
1814 nbub_l = 0._wp
1815 nbub_r = 0._wp
1816
1817# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1818#if defined(MFC_OpenACC)
1819# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1820!$acc loop seq
1821# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1822#elif defined(MFC_OpenMP)
1823# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1824
1825# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1826#endif
1827 do i = 1, nb
1828 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
1829 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
1830 end do
1831
1832 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
1833 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
1834 & eqn_idx%E + num_fluids)/nbub_r
1835 end if
1836 else
1837 ! nb stored in 0th moment of first R0 bin in variable conversion module
1838 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
1839 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
1840 end if
1841
1842
1843# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1844#if defined(MFC_OpenACC)
1845# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1846!$acc loop seq
1847# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1848#elif defined(MFC_OpenMP)
1849# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1850
1851# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1852#endif
1853 do i = 1, nb
1854 if (.not. qbmm) then
1855 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
1856 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
1857 end if
1858 end do
1859
1860 if (qbmm) then
1861 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
1862 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
1863
1864 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
1865 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
1866
1867 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
1868 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
1869 else
1870 pbwr3lbar = 0._wp
1871 pbwr3rbar = 0._wp
1872
1873 r3lbar = 0._wp
1874 r3rbar = 0._wp
1875
1876 r3v2lbar = 0._wp
1877 r3v2rbar = 0._wp
1878
1879
1880# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1881#if defined(MFC_OpenACC)
1882# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1883!$acc loop seq
1884# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1885#elif defined(MFC_OpenMP)
1886# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1887
1888# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1889#endif
1890 do i = 1, nb
1891 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
1892 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
1893
1894 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
1895 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
1896
1897 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
1898 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
1899 end do
1900 end if
1901
1902 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1903 h_avg = 5.e-1_wp*(h_l + h_r)
1904 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1905 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1906 vel_avg_rms = 0._wp
1907
1908
1909# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1910#if defined(MFC_OpenACC)
1911# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1912!$acc loop seq
1913# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1914#elif defined(MFC_OpenMP)
1915# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1916
1917# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1918#endif
1919 do i = 1, num_dims
1920 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1921 end do
1922 end if
1923
1924 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
1925 & c_l, qv_l)
1926
1927 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
1928 & c_r, qv_r)
1929
1930 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1931 ! variables are placeholders to call the subroutine.
1932 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1933 & 0._wp, c_avg, qv_avg)
1934
1935 if (viscous) then
1936
1937# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1938#if defined(MFC_OpenACC)
1939# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1940!$acc loop seq
1941# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1942#elif defined(MFC_OpenMP)
1943# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1944
1945# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1946#endif
1947 do i = 1, 2
1948 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1949 end do
1950 end if
1951
1952 ! Low Mach correction
1953 if (low_mach == 2) then
1954 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
1955# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1956 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1957# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1958 pcorr = 0._wp
1959# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1960
1961# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1962 if (low_mach == 1) then
1963# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1964 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1965# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1966 end if
1967# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1968 else if (riemann_solver == riemann_solver_hllc) then
1969# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1970 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1971# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1972 pcorr = 0._wp
1973# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1974
1975# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1976 if (low_mach == 1) then
1977# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1978 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))) &
1979# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1980 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1981# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1982 else if (low_mach == 2) then
1983# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1984 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))))
1985# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1986 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))))
1987# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1988 vel_l(dir_idx(1)) = vel_l_tmp
1989# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1990 vel_r(dir_idx(1)) = vel_r_tmp
1991# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1992 end if
1993# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
1994 end if
1995 end if
1996
1997 if (wave_speeds == wave_speeds_direct) then
1998 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1999 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2000
2001 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2002 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2003 & - rho_r*(s_r - vel_r(dir_idx(1))))
2004 else if (wave_speeds == wave_speeds_pressure) then
2005 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2006
2007 pres_sr = pres_sl
2008
2009 ! Low Mach correction: Thornber et al. JCP (2008)
2010 ms_l = max(1._wp, &
2011 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2012 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2013 ms_r = max(1._wp, &
2014 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2015 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2016
2017 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2018 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2019
2020 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2021 end if
2022
2023 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2024 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2025
2026 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2027 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2028 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2029 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2030 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2031
2032 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2033 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2034 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2035
2036 ! Low Mach correction
2037 if (low_mach == 1) then
2038 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2039# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2040 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2041# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2042 pcorr = 0._wp
2043# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2044
2045# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2046 if (low_mach == 1) then
2047# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2048 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2049# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2050 end if
2051# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2052 else if (riemann_solver == riemann_solver_hllc) then
2053# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2054 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2055# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2056 pcorr = 0._wp
2057# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2058
2059# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2060 if (low_mach == 1) then
2061# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2062 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))) &
2063# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2064 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2065# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2066 else if (low_mach == 2) then
2067# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2068 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))))
2069# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2070 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))))
2071# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2072 vel_l(dir_idx(1)) = vel_l_tmp
2073# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2074 vel_r(dir_idx(1)) = vel_r_tmp
2075# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2076 end if
2077# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2078 end if
2079 else
2080 pcorr = 0._wp
2081 end if
2082
2083
2084# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2085#if defined(MFC_OpenACC)
2086# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2087!$acc loop seq
2088# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2089#elif defined(MFC_OpenMP)
2090# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2091
2092# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2093#endif
2094 do i = 1, eqn_idx%cont%end
2095 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2096 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2097 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2098 end do
2099
2100 if (bubbles_euler .and. (num_fluids > 1)) then
2101 ! Kill mass transport @ gas density
2102 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
2103 end if
2104
2105 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
2106
2107 ! Include p_tilde
2108
2109 if (avg_state == avg_state_arithmetic) then
2110 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
2111 pres_l = pres_l - alpha_l(num_fluids)*pres_l
2112 else
2113 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
2114 end if
2115
2116 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
2117 pres_r = pres_r - alpha_r(num_fluids)*pres_r
2118 else
2119 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
2120 end if
2121 end if
2122
2123
2124# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2125#if defined(MFC_OpenACC)
2126# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2127!$acc loop seq
2128# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2129#elif defined(MFC_OpenMP)
2130# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2131
2132# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2133#endif
2134 do i = 1, num_dims
2135 flux_rsx_vf(j, k, l, &
2136 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
2137 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
2138 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
2139 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2140 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
2141 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
2142 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
2143 end do
2144
2145 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
2146 flux_rsx_vf(j, k, l, &
2147 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
2148 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
2149 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
2150 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
2151 & *pcorr*s_s
2152
2153 ! Volume fraction flux
2154
2155# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2156#if defined(MFC_OpenACC)
2157# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2158!$acc loop seq
2159# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2160#elif defined(MFC_OpenMP)
2161# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2162
2163# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2164#endif
2165 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2166 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2167 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2168 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2169 end do
2170
2171 ! Advection velocity source: interface velocity for volume fraction transport
2172
2173# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2174#if defined(MFC_OpenACC)
2175# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2176!$acc loop seq
2177# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2178#elif defined(MFC_OpenMP)
2179# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2180
2181# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2182#endif
2183 do i = 1, num_dims
2184 vel_src_rsx_vf(j, k, l, &
2185 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2186 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2187
2188 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
2189 end do
2190
2191 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2192
2193 ! Add advection flux for bubble variables
2194
2195# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2196#if defined(MFC_OpenACC)
2197# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2198!$acc loop seq
2199# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2200#elif defined(MFC_OpenMP)
2201# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2202
2203# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2204#endif
2205 do i = eqn_idx%bub%beg, eqn_idx%bub%end
2206 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
2207 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2208 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2209 end do
2210
2211 if (qbmm) then
2212 flux_rsx_vf(j, k, l, &
2213 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2214 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2215 end if
2216
2217 if (adv_n) then
2218 flux_rsx_vf(j, k, l, &
2219 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2220 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2221 end if
2222
2223 ! Geometrical source flux for cylindrical coordinates
2224# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2225# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2226 end do
2227 end do
2228 end do
2229
2230# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2231#if defined(MFC_OpenACC)
2232# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2233!$acc end parallel loop
2234# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2235#elif defined(MFC_OpenMP)
2236# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2237
2238# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2239!$omp end target teams loop
2240# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2241#endif
2242 else
2243 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
2244
2245# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2246
2247# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2248#if defined(MFC_OpenACC)
2249# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2250!$acc parallel loop collapse(3) gang vector default(present) &
2251# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2252!$acc& private(i, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, 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, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, 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) &
2253# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2254!$acc& firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
2255# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2256#elif defined(MFC_OpenMP)
2257# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2258
2259# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2260
2261# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2262
2263# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2264!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2265# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2266!$omp& private(i, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, 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, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, 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) &
2267# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2268!$omp& firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
2269# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2270#endif
2271# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2272 do l = is3%beg, is3%end
2273 do k = is2%beg, is2%end
2274 do j = is1%beg, is1%end
2275 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2276 rho_l = 0._wp; rho_r = 0._wp
2277 gamma_l = 0._wp; gamma_r = 0._wp
2278 pi_inf_l = 0._wp; pi_inf_r = 0._wp
2279 qv_l = 0._wp; qv_r = 0._wp
2280 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
2281
2282
2283# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2284#if defined(MFC_OpenACC)
2285# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2286!$acc loop seq
2287# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2288#elif defined(MFC_OpenMP)
2289# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2290
2291# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2292#endif
2293 do i = 1, num_fluids
2294 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2295 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2296 end do
2297
2298
2299# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2300#if defined(MFC_OpenACC)
2301# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2302!$acc loop seq
2303# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2304#elif defined(MFC_OpenMP)
2305# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2306
2307# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2308#endif
2309 do i = 1, num_dims
2310 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2311 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
2312 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2313 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2314 end do
2315
2316 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2317 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
2318
2319 ! Change this by splitting it into the cases present in the bubbles_euler
2320 if (mpp_lim) then
2321
2322# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2323#if defined(MFC_OpenACC)
2324# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2325!$acc loop seq
2326# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2327#elif defined(MFC_OpenMP)
2328# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2329
2330# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2331#endif
2332 do i = 1, num_fluids
2333 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
2334 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
2335 & eqn_idx%E + i)), 1._wp)
2336 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
2337 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
2338 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
2339 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2340 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2341 end do
2342
2343
2344# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2345#if defined(MFC_OpenACC)
2346# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2347!$acc loop seq
2348# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2349#elif defined(MFC_OpenMP)
2350# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2351
2352# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2353#endif
2354 do i = 1, num_fluids
2355 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
2356 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
2357 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
2358 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
2359 end do
2360 end if
2361
2362 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
2363 ! downstream
2364
2365# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2366#if defined(MFC_OpenACC)
2367# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2368!$acc loop seq
2369# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2370#elif defined(MFC_OpenMP)
2371# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2372
2373# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2374#endif
2375 do i = 1, num_fluids
2376 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2377 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
2378 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2379 alpha_lim_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
2380 end do
2381
2382 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
2383 & pi_inf_l, qv_l)
2384 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
2385 & pi_inf_r, qv_r)
2386
2387 if (viscous) then
2388 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
2389 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
2390 end if
2391
2392 if (chemistry) then
2393 c_sum_yi_phi = 0.0_wp
2394
2395# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2396#if defined(MFC_OpenACC)
2397# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2398!$acc loop seq
2399# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2400#elif defined(MFC_OpenMP)
2401# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2402
2403# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2404#endif
2405 do i = eqn_idx%species%beg, eqn_idx%species%end
2406 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2407 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
2408 end do
2409
2410 call get_mixture_molecular_weight(ys_l, mw_l)
2411 call get_mixture_molecular_weight(ys_r, mw_r)
2412
2413 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2414 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2415
2416 r_gas_l = gas_constant/mw_l
2417 r_gas_r = gas_constant/mw_r
2418
2419 t_l = pres_l/rho_l/r_gas_l
2420 t_r = pres_r/rho_r/r_gas_r
2421
2422 call get_species_specific_heats_r(t_l, cp_il)
2423 call get_species_specific_heats_r(t_r, cp_ir)
2424
2425 if (chem_params%gamma_method == 1) then
2426 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2427 gamma_il = cp_il/(cp_il - 1.0_wp)
2428 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2429
2430 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2431 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2432 else if (chem_params%gamma_method == 2) then
2433 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2434 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2435 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2436 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2437 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2438
2439 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
2440 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2441 end if
2442
2443 call get_mixture_energy_mass(t_l, ys_l, e_l)
2444 call get_mixture_energy_mass(t_r, ys_r, e_r)
2445
2446 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2447 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2448 h_l = (e_l + pres_l)/rho_l
2449 h_r = (e_r + pres_r)/rho_r
2450 else
2451 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2452 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2453
2454 h_l = (e_l + pres_l)/rho_l
2455 h_r = (e_r + pres_r)/rho_r
2456 end if
2457
2458 ! Hyperelastic stress contribution: strain energy added to total energy
2459 if (hyperelasticity) then
2460
2461# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2462#if defined(MFC_OpenACC)
2463# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2464!$acc loop seq
2465# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2466#elif defined(MFC_OpenMP)
2467# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2468
2469# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2470#endif
2471 do i = 1, num_dims
2472 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
2473 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
2474 end do
2475 g_l = 0._wp
2476 g_r = 0._wp
2477
2478# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2479#if defined(MFC_OpenACC)
2480# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2481!$acc loop seq
2482# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2483#elif defined(MFC_OpenMP)
2484# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2485
2486# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2487#endif
2488 do i = 1, num_fluids
2489 ! Mixture left and right shear modulus
2490 g_l = g_l + alpha_l(i)*gs_rs(i)
2491 g_r = g_r + alpha_r(i)*gs_rs(i)
2492 end do
2493 ! Elastic contribution to energy if G large enough
2494 if (g_l > verysmall .and. g_r > verysmall) then
2495 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
2496 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
2497 end if
2498
2499# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2500#if defined(MFC_OpenACC)
2501# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2502!$acc loop seq
2503# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2504#elif defined(MFC_OpenMP)
2505# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2506
2507# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2508#endif
2509 do i = 1, b_size - 1
2510 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2511 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2512 end do
2513 end if
2514
2515 h_l = (e_l + pres_l)/rho_l
2516 h_r = (e_r + pres_r)/rho_r
2517
2518 if (avg_state == avg_state_roe) then
2519# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2520 rho_avg = sqrt(rho_l*rho_r)
2521# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2522
2523# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2524 vel_avg_rms = 0._wp
2525# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2526
2527# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2528
2529# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2530#if defined(MFC_OpenACC)
2531# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2532!$acc loop seq
2533# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2534#elif defined(MFC_OpenMP)
2535# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2536
2537# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2538#endif
2539# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2540 do i = 1, num_vels
2541# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2542 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
2543# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2544 end do
2545# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2546
2547# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2548 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
2549# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2550
2551# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2552 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
2553# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2554
2555# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2556 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
2557# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2558
2559# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2560 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
2561# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2562
2563# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2564 if (chemistry) then
2565# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2566 eps = 0.001_wp
2567# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2568 call get_species_enthalpies_rt(t_l, h_il)
2569# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2570 call get_species_enthalpies_rt(t_r, h_ir)
2571# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2572 h_il = h_il*gas_constant/molecular_weights*t_l
2573# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2574 h_ir = h_ir*gas_constant/molecular_weights*t_r
2575# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2576 call get_species_specific_heats_r(t_l, cp_il)
2577# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2578 call get_species_specific_heats_r(t_r, cp_ir)
2579# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2580
2581# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2582 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2583# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2584 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2585# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2586 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2587# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2588 if (abs(t_l - t_r) < eps) then
2589# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2590 ! Case when T_L and T_R are very close
2591# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2592 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2593# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2594 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2595# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2596 & - gas_constant/molecular_weights(:)))
2597# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2598 else
2599# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2600 ! Normal calculation when T_L and T_R are sufficiently different
2601# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2602 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2603# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2604 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2605# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2606 end if
2607# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2608 gamma_avg = cp_avg/cv_avg
2609# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2610
2611# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2612 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2613# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2614 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2615# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2616 end if
2617# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2618 end if
2619# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2620
2621# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2622 if (avg_state == avg_state_arithmetic) then
2623# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2624 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2625# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2626 vel_avg_rms = 0._wp
2627# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2628
2629# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2630#if defined(MFC_OpenACC)
2631# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2632!$acc loop seq
2633# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2634#elif defined(MFC_OpenMP)
2635# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2636
2637# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2638#endif
2639# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2640 do i = 1, num_vels
2641# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2642 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2643# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2644 end do
2645# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2646
2647# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2648 h_avg = 5.e-1_wp*(h_l + h_r)
2649# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2650 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2651# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2652 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2653# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2654 end if
2655
2656 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
2657 & c_l, qv_l)
2658
2659 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
2660 & c_r, qv_r)
2661
2662 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2663 ! variables are placeholders to call the subroutine.
2664 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2665 & c_sum_yi_phi, c_avg, qv_avg)
2666
2667 if (viscous) then
2668 if (chemistry) then
2669 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2670 end if
2671
2672# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2673#if defined(MFC_OpenACC)
2674# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2675!$acc loop seq
2676# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2677#elif defined(MFC_OpenMP)
2678# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2679
2680# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2681#endif
2682 do i = 1, 2
2683 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2684 end do
2685 end if
2686
2687 ! Low Mach correction
2688 if (low_mach == 2) then
2689 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2690# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2691 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2692# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2693 pcorr = 0._wp
2694# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2695
2696# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2697 if (low_mach == 1) then
2698# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2699 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2700# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2701 end if
2702# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2703 else if (riemann_solver == riemann_solver_hllc) then
2704# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2705 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2706# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2707 pcorr = 0._wp
2708# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2709
2710# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2711 if (low_mach == 1) then
2712# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2713 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))) &
2714# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2715 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2716# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2717 else if (low_mach == 2) then
2718# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2719 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))))
2720# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2721 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))))
2722# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2723 vel_l(dir_idx(1)) = vel_l_tmp
2724# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2725 vel_r(dir_idx(1)) = vel_r_tmp
2726# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2727 end if
2728# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2729 end if
2730 end if
2731
2732 if (wave_speeds == wave_speeds_direct) then
2733 if (elasticity) then
2734 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2735 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) &
2736 & ))/rho_l), &
2737 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
2738 & + tau_e_r(dir_idx_tau(1)))/rho_r))
2739 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) &
2740 & ))/rho_r), &
2741 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
2742 & + tau_e_l(dir_idx_tau(1)))/rho_l))
2743 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
2744 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
2745 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
2746 & - vel_r(dir_idx(1))))
2747 else
2748 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2749 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2750 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2751 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
2752 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
2753 end if
2754 else if (wave_speeds == wave_speeds_pressure) then
2755 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2756
2757 pres_sr = pres_sl
2758
2759 ! Low Mach correction: Thornber et al. JCP (2008)
2760 ms_l = max(1._wp, &
2761 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2762 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2763 ms_r = max(1._wp, &
2764 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2765 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2766
2767 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2768 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2769
2770 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2771 end if
2772
2773 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
2774 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2775
2776 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
2777 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2778 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2779 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
2780 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
2781 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
2782
2783 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
2784 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
2785 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
2786
2787 ! Low Mach correction
2788 if (low_mach == 1) then
2789 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
2790# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2791 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2792# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2793 pcorr = 0._wp
2794# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2795
2796# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2797 if (low_mach == 1) then
2798# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2799 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2800# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2801 end if
2802# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2803 else if (riemann_solver == riemann_solver_hllc) then
2804# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2805 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2806# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2807 pcorr = 0._wp
2808# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2809
2810# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2811 if (low_mach == 1) then
2812# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2813 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))) &
2814# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2815 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2816# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2817 else if (low_mach == 2) then
2818# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2819 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))))
2820# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2821 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))))
2822# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2823 vel_l(dir_idx(1)) = vel_l_tmp
2824# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2825 vel_r(dir_idx(1)) = vel_r_tmp
2826# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2827 end if
2828# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2829 end if
2830 else
2831 pcorr = 0._wp
2832 end if
2833
2834 ! COMPUTING THE HLLC FLUXES MASS FLUX.
2835
2836# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2837#if defined(MFC_OpenACC)
2838# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2839!$acc loop seq
2840# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2841#elif defined(MFC_OpenMP)
2842# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2843
2844# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2845#endif
2846 do i = 1, eqn_idx%cont%end
2847 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2848 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2849 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2850 end do
2851
2852 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
2853 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
2854
2855# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2856#if defined(MFC_OpenACC)
2857# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2858!$acc loop seq
2859# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2860#elif defined(MFC_OpenMP)
2861# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2862
2863# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2864#endif
2865 do i = 1, num_dims
2866 flux_rsx_vf(j, k, l, &
2867 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
2868 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
2869 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
2870 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
2871 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
2872 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
2873 end do
2874
2875 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
2876 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
2877 flux_rsx_vf(j, k, l, &
2878 & 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 &
2879 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
2880 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
2881 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
2882 & *(s_p/s_r)*pcorr*s_s
2883
2884 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
2885 if (elasticity) then
2886 flux_ene_e = 0._wp
2887
2888# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2889#if defined(MFC_OpenACC)
2890# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2891!$acc loop seq
2892# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2893#elif defined(MFC_OpenMP)
2894# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2895
2896# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2897#endif
2898 do i = 1, num_dims
2899 ! MOMENTUM ELASTIC FLUX.
2900 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
2901 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
2902 & - xi_p*tau_e_r(dir_idx_tau(i))
2903 ! ENERGY ELASTIC FLUX.
2904 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
2905 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
2906 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
2907 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
2908 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
2909 end do
2910 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
2911 end if
2912
2913 ! VOLUME FRACTION FLUX.
2914
2915# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2916#if defined(MFC_OpenACC)
2917# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2918!$acc loop seq
2919# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2920#elif defined(MFC_OpenMP)
2921# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2922
2923# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2924#endif
2925 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2926 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
2927 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
2928 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2929 end do
2930
2931 ! VOLUME FRACTION SOURCE FLUX.
2932
2933# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2934#if defined(MFC_OpenACC)
2935# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2936!$acc loop seq
2937# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2938#elif defined(MFC_OpenMP)
2939# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2940
2941# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2942#endif
2943 do i = 1, num_dims
2944 vel_src_rsx_vf(j, k, l, &
2945 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
2946 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
2947 end do
2948
2949 ! COLOR FUNCTION FLUX
2950 if (surface_tension) then
2951 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
2952 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2953 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2954 end if
2955
2956 ! Hyperelastic reference map flux for material deformation tracking
2957 if (hyperelasticity) then
2958
2959# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2960#if defined(MFC_OpenACC)
2961# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2962!$acc loop seq
2963# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2964#elif defined(MFC_OpenMP)
2965# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2966
2967# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2968#endif
2969 do i = 1, num_dims
2970 flux_rsx_vf(j, k, l, &
2971 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
2972 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
2973 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
2974 end do
2975 end if
2976
2977 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
2978
2979 if (chemistry) then
2980
2981# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2982#if defined(MFC_OpenACC)
2983# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2984!$acc loop seq
2985# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2986#elif defined(MFC_OpenMP)
2987# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2988
2989# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
2990#endif
2991 do i = eqn_idx%species%beg, eqn_idx%species%end
2992 y_l = ql_prim_rsx_vf(j, k, l, i)
2993 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
2994
2995 flux_rsx_vf(j, k, l, &
2996 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
2997 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
2998 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
2999 end do
3000 end if
3001
3002 ! Geometrical source flux for cylindrical coordinates
3003# 1470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3004# 1484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3005 end do
3006 end do
3007 end do
3008
3009# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3010#if defined(MFC_OpenACC)
3011# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3012!$acc end parallel loop
3013# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3014#elif defined(MFC_OpenMP)
3015# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3016
3017# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3018!$omp end target teams loop
3019# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3020#endif
3021 end if
3022 end if
3023# 140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3024# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3025# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3026 if (norm_dir == 2) then
3027 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
3028 if (model_eqns == model_eqns_6eq) then
3029 ! 6-equation model (model_eqns=3): separate phasic internal energies
3030
3031# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3032
3033# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3034#if defined(MFC_OpenACC)
3035# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3036!$acc parallel loop collapse(3) gang vector default(present) &
3037# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3038!$acc& private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, 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) &
3039# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3040!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
3041# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3042#elif defined(MFC_OpenMP)
3043# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3044
3045# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3046
3047# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3048
3049# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3050!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3051# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3052!$omp& private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, 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) &
3053# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3054!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
3055# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3056#endif
3057# 157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3058 do l = is3%beg, is3%end
3059 do k = is1%beg, is1%end
3060 do j = is2%beg, is2%end
3061 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3062 rho_l = 0._wp; rho_r = 0._wp
3063 gamma_l = 0._wp; gamma_r = 0._wp
3064 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3065 qv_l = 0._wp; qv_r = 0._wp
3066 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
3067
3068
3069# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3070#if defined(MFC_OpenACC)
3071# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3072!$acc loop seq
3073# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3074#elif defined(MFC_OpenMP)
3075# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3076
3077# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3078#endif
3079 do i = 1, num_dims
3080 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3081 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3082 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3083 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3084 end do
3085
3086 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3087 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3088
3089 rho_l = 0._wp
3090 gamma_l = 0._wp
3091 pi_inf_l = 0._wp
3092 qv_l = 0._wp
3093
3094 rho_r = 0._wp
3095 gamma_r = 0._wp
3096 pi_inf_r = 0._wp
3097 qv_r = 0._wp
3098
3099 alpha_l_sum = 0._wp
3100 alpha_r_sum = 0._wp
3101
3102 if (mpp_lim) then
3103
3104# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3105#if defined(MFC_OpenACC)
3106# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3107!$acc loop seq
3108# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3109#elif defined(MFC_OpenMP)
3110# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3111
3112# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3113#endif
3114 do i = 1, num_fluids
3115 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
3116 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
3117 & eqn_idx%E + i)), 1._wp)
3118 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3119 end do
3120
3121
3122# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3123#if defined(MFC_OpenACC)
3124# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3125!$acc loop seq
3126# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3127#elif defined(MFC_OpenMP)
3128# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3129
3130# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3131#endif
3132 do i = 1, num_fluids
3133 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
3134 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
3135 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
3136 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3137 end do
3138
3139
3140# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3141#if defined(MFC_OpenACC)
3142# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3143!$acc loop seq
3144# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3145#elif defined(MFC_OpenMP)
3146# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3147
3148# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3149#endif
3150 do i = 1, num_fluids
3151 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
3152 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
3153 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
3154 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
3155 end do
3156 end if
3157
3158
3159# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3160#if defined(MFC_OpenACC)
3161# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3162!$acc loop seq
3163# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3164#elif defined(MFC_OpenMP)
3165# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3166
3167# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3168#endif
3169 do i = 1, num_fluids
3170 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3171 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3172 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
3173 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
3174 end do
3175
3176 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
3177 & qv_l)
3178 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
3179 & qv_r)
3180
3181 if (viscous) then
3182 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
3183 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
3184 end if
3185
3186 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
3187 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
3188
3189 ! Hyperelastic stress contribution: strain energy added to total energy
3190 if (hyperelasticity) then
3191
3192# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3193#if defined(MFC_OpenACC)
3194# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3195!$acc loop seq
3196# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3197#elif defined(MFC_OpenMP)
3198# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3199
3200# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3201#endif
3202 do i = 1, num_dims
3203 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
3204 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
3205 end do
3206 g_l = 0._wp; g_r = 0._wp
3207
3208# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3209#if defined(MFC_OpenACC)
3210# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3211!$acc loop seq
3212# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3213#elif defined(MFC_OpenMP)
3214# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3215
3216# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3217#endif
3218 do i = 1, num_fluids
3219 ! Mixture left and right shear modulus
3220 g_l = g_l + alpha_l(i)*gs_rs(i)
3221 g_r = g_r + alpha_r(i)*gs_rs(i)
3222 end do
3223 ! Elastic contribution to energy if G large enough
3224 if (g_l > verysmall .and. g_r > verysmall) then
3225 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
3226 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
3227 end if
3228
3229# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3230#if defined(MFC_OpenACC)
3231# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3232!$acc loop seq
3233# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3234#elif defined(MFC_OpenMP)
3235# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3236
3237# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3238#endif
3239 do i = 1, b_size - 1
3240 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
3241 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
3242 end do
3243 end if
3244
3245 h_l = (e_l + pres_l)/rho_l
3246 h_r = (e_r + pres_r)/rho_r
3247
3248 if (avg_state == avg_state_roe) then
3249# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3250 rho_avg = sqrt(rho_l*rho_r)
3251# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3252
3253# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3254 vel_avg_rms = 0._wp
3255# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3256
3257# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3258
3259# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3260#if defined(MFC_OpenACC)
3261# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3262!$acc loop seq
3263# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3264#elif defined(MFC_OpenMP)
3265# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3266
3267# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3268#endif
3269# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3270 do i = 1, num_vels
3271# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3272 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
3273# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3274 end do
3275# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3276
3277# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3278 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3279# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3280
3281# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3282 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3283# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3284
3285# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3286 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
3287# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3288
3289# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3290 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3291# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3292
3293# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3294 if (chemistry) then
3295# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3296 eps = 0.001_wp
3297# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3298 call get_species_enthalpies_rt(t_l, h_il)
3299# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3300 call get_species_enthalpies_rt(t_r, h_ir)
3301# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3302 h_il = h_il*gas_constant/molecular_weights*t_l
3303# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3304 h_ir = h_ir*gas_constant/molecular_weights*t_r
3305# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3306 call get_species_specific_heats_r(t_l, cp_il)
3307# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3308 call get_species_specific_heats_r(t_r, cp_ir)
3309# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3310
3311# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3312 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3313# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3314 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3315# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3316 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3317# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3318 if (abs(t_l - t_r) < eps) then
3319# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3320 ! Case when T_L and T_R are very close
3321# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3322 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3323# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3324 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3325# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3326 & - gas_constant/molecular_weights(:)))
3327# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3328 else
3329# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3330 ! Normal calculation when T_L and T_R are sufficiently different
3331# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3332 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3333# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3334 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3335# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3336 end if
3337# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3338 gamma_avg = cp_avg/cv_avg
3339# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3340
3341# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3342 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3343# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3344 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3345# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3346 end if
3347# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3348 end if
3349# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3350
3351# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3352 if (avg_state == avg_state_arithmetic) then
3353# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3354 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3355# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3356 vel_avg_rms = 0._wp
3357# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3358
3359# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3360#if defined(MFC_OpenACC)
3361# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3362!$acc loop seq
3363# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3364#elif defined(MFC_OpenMP)
3365# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3366
3367# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3368#endif
3369# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3370 do i = 1, num_vels
3371# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3372 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3373# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3374 end do
3375# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3376
3377# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3378 h_avg = 5.e-1_wp*(h_l + h_r)
3379# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3380 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3381# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3382 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3383# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3384 end if
3385
3386 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
3387 & c_l, qv_l)
3388
3389 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
3390 & c_r, qv_r)
3391
3392 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3393 ! variables are placeholders to call the subroutine.
3394 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3395 & 0._wp, c_avg, qv_avg)
3396
3397 if (viscous) then
3398
3399# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3400#if defined(MFC_OpenACC)
3401# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3402!$acc loop seq
3403# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3404#elif defined(MFC_OpenMP)
3405# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3406
3407# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3408#endif
3409 do i = 1, 2
3410 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3411 end do
3412 end if
3413
3414 ! Low Mach correction
3415 if (low_mach == 2) then
3416 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3417# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3418 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3419# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3420 pcorr = 0._wp
3421# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3422
3423# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3424 if (low_mach == 1) then
3425# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3426 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3427# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3428 end if
3429# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3430 else if (riemann_solver == riemann_solver_hllc) then
3431# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3432 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3433# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3434 pcorr = 0._wp
3435# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3436
3437# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3438 if (low_mach == 1) then
3439# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3440 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))) &
3441# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3442 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3443# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3444 else if (low_mach == 2) then
3445# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3446 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))))
3447# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3448 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))))
3449# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3450 vel_l(dir_idx(1)) = vel_l_tmp
3451# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3452 vel_r(dir_idx(1)) = vel_r_tmp
3453# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3454 end if
3455# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3456 end if
3457 end if
3458
3459 ! COMPUTING THE DIRECT WAVE SPEEDS
3460 if (wave_speeds == wave_speeds_direct) then
3461 if (elasticity) then
3462 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3463 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) &
3464 & ))/rho_l), &
3465 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
3466 & + tau_e_r(dir_idx_tau(1)))/rho_r))
3467 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) &
3468 & ))/rho_r), &
3469 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
3470 & + tau_e_l(dir_idx_tau(1)))/rho_l))
3471 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
3472 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
3473 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
3474 & - vel_r(dir_idx(1))))
3475 else
3476 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3477 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3478 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3479 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
3480 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
3481 end if
3482 else if (wave_speeds == wave_speeds_pressure) then
3483 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3484
3485 pres_sr = pres_sl
3486
3487 ! Low Mach correction: Thornber et al. JCP (2008)
3488 ms_l = max(1._wp, &
3489 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3490 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3491 ms_r = max(1._wp, &
3492 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3493 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3494
3495 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3496 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3497
3498 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3499 end if
3500
3501 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
3502 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3503
3504 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
3505 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3506 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3507 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
3508 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
3509
3510 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
3511 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
3512 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
3513
3514 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
3515 xi_mp = -min(0._wp, sign(1._wp, s_l))
3516 xi_pp = max(0._wp, sign(1._wp, s_r))
3517
3518 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 &
3519 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
3520 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
3521 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
3522 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
3523
3524 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))
3525
3526 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 &
3527 & - vel_r(dir_idx(1)))
3528
3529 ! Low Mach correction
3530 if (low_mach == 1) then
3531 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
3532# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3533 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3534# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3535 pcorr = 0._wp
3536# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3537
3538# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3539 if (low_mach == 1) then
3540# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3541 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3542# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3543 end if
3544# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3545 else if (riemann_solver == riemann_solver_hllc) then
3546# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3547 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3548# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3549 pcorr = 0._wp
3550# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3551
3552# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3553 if (low_mach == 1) then
3554# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3555 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))) &
3556# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3557 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3558# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3559 else if (low_mach == 2) then
3560# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3561 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))))
3562# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3563 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))))
3564# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3565 vel_l(dir_idx(1)) = vel_l_tmp
3566# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3567 vel_r(dir_idx(1)) = vel_r_tmp
3568# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3569 end if
3570# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3571 end if
3572 else
3573 pcorr = 0._wp
3574 end if
3575
3576 ! COMPUTING FLUXES MASS FLUX.
3577
3578# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3579#if defined(MFC_OpenACC)
3580# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3581!$acc loop seq
3582# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3583#elif defined(MFC_OpenMP)
3584# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3585
3586# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3587#endif
3588 do i = 1, eqn_idx%cont%end
3589 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3590 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3591 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
3592 end do
3593
3594 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
3595
3596# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3597#if defined(MFC_OpenACC)
3598# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3599!$acc loop seq
3600# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3601#elif defined(MFC_OpenMP)
3602# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3603
3604# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3605#endif
3606 do i = 1, num_dims
3607 flux_rsx_vf(j, k, l, &
3608 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
3609 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
3610 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
3611 & *dir_flg(dir_idx(i))*pcorr
3612 end do
3613
3614 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
3615 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
3616
3617 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
3618 if (elasticity) then
3619 flux_ene_e = 0._wp
3620
3621# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3622#if defined(MFC_OpenACC)
3623# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3624!$acc loop seq
3625# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3626#elif defined(MFC_OpenMP)
3627# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3628
3629# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3630#endif
3631 do i = 1, num_dims
3632 ! MOMENTUM ELASTIC FLUX.
3633 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
3634 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
3635 & - xi_p*tau_e_r(dir_idx_tau(i))
3636 ! ENERGY ELASTIC FLUX.
3637 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
3638 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
3639 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
3640 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
3641 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
3642 end do
3643 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
3644 end if
3645
3646 ! VOLUME FRACTION FLUX.
3647
3648# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3649#if defined(MFC_OpenACC)
3650# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3651!$acc loop seq
3652# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3653#elif defined(MFC_OpenMP)
3654# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3655
3656# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3657#endif
3658 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3659 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
3660 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
3661 end do
3662
3663 ! Advection velocity source: interface velocity for volume fraction transport
3664
3665# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3666#if defined(MFC_OpenACC)
3667# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3668!$acc loop seq
3669# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3670#elif defined(MFC_OpenMP)
3671# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3672
3673# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3674#endif
3675 do i = 1, num_dims
3676 vel_src_rsx_vf(j, k, l, &
3677 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3678 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
3679 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
3680 end do
3681
3682 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
3683 ! energy flux
3684
3685# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3686#if defined(MFC_OpenACC)
3687# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3688!$acc loop seq
3689# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3690#elif defined(MFC_OpenMP)
3691# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3692
3693# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3694#endif
3695 do i = 1, num_fluids
3696 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
3697 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
3698 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
3699 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
3700 & + pres_r)
3701
3702 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
3703 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3704 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
3705 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
3706 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3707 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
3708 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
3709 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
3710 & i + eqn_idx%adv%beg - 1))
3711 end do
3712
3713 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
3714
3715 ! Hyperelastic reference map flux for material deformation tracking
3716 if (hyperelasticity) then
3717
3718# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3719#if defined(MFC_OpenACC)
3720# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3721!$acc loop seq
3722# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3723#elif defined(MFC_OpenMP)
3724# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3725
3726# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3727#endif
3728 do i = 1, num_dims
3729 flux_rsx_vf(j, k, l, &
3730 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
3731 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
3732 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
3733 end do
3734 end if
3735
3736 ! COLOR FUNCTION FLUX
3737 if (surface_tension) then
3738 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
3739 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
3740 end if
3741
3742 ! Geometrical source flux for cylindrical coordinates
3743# 467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3744 if (cyl_coord) then
3745 ! Substituting the advective flux into the inviscid geometrical source flux
3746
3747# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3748#if defined(MFC_OpenACC)
3749# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3750!$acc loop seq
3751# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3752#elif defined(MFC_OpenMP)
3753# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3754
3755# 469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3756#endif
3757 do i = 1, eqn_idx%E
3758 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3759 end do
3760
3761# 473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3762#if defined(MFC_OpenACC)
3763# 473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3764!$acc loop seq
3765# 473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3766#elif defined(MFC_OpenMP)
3767# 473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3768
3769# 473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3770#endif
3771 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
3772 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3773 end do
3774 ! Recalculating the radial momentum geometric source flux
3775 flux_gsrc_rsx_vf(j, k, l, &
3776 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
3777 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
3778 ! Geometrical source of the void fraction(s) is zero
3779
3780# 482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3781#if defined(MFC_OpenACC)
3782# 482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3783!$acc loop seq
3784# 482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3785#elif defined(MFC_OpenMP)
3786# 482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3787
3788# 482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3789#endif
3790 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3791 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
3792 end do
3793 end if
3794# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3795# 501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3796 end do
3797 end do
3798 end do
3799
3800# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3801#if defined(MFC_OpenACC)
3802# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3803!$acc end parallel loop
3804# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3805#elif defined(MFC_OpenMP)
3806# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3807
3808# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3809!$omp end target teams loop
3810# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3811#endif
3812 else if (model_eqns == model_eqns_4eq) then
3813 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
3814
3815# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3816
3817# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3818#if defined(MFC_OpenACC)
3819# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3820!$acc parallel loop collapse(3) gang vector default(present) &
3821# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3822!$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)
3823# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3824#elif defined(MFC_OpenMP)
3825# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3826
3827# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3828
3829# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3830
3831# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3832!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3833# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3834!$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)
3835# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3836#endif
3837# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3838 do l = is3%beg, is3%end
3839 do k = is1%beg, is1%end
3840 do j = is2%beg, is2%end
3841 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3842 rho_l = 0._wp; rho_r = 0._wp
3843 gamma_l = 0._wp; gamma_r = 0._wp
3844 pi_inf_l = 0._wp; pi_inf_r = 0._wp
3845 qv_l = 0._wp; qv_r = 0._wp
3846
3847
3848# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3849#if defined(MFC_OpenACC)
3850# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3851!$acc loop seq
3852# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3853#elif defined(MFC_OpenMP)
3854# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3855
3856# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3857#endif
3858 do i = 1, eqn_idx%cont%end
3859 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3860 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
3861 end do
3862
3863
3864# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3865#if defined(MFC_OpenACC)
3866# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3867!$acc loop seq
3868# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3869#elif defined(MFC_OpenMP)
3870# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3871
3872# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3873#endif
3874 do i = 1, num_dims
3875 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3876 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
3877 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3878 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3879 end do
3880
3881
3882# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3883#if defined(MFC_OpenACC)
3884# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3885!$acc loop seq
3886# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3887#elif defined(MFC_OpenMP)
3888# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3889
3890# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3891#endif
3892 do i = 1, num_fluids
3893 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3894 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3895 end do
3896
3897# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3898#if defined(MFC_OpenACC)
3899# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3900!$acc loop seq
3901# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3902#elif defined(MFC_OpenMP)
3903# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3904
3905# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3906#endif
3907 do i = 1, num_fluids
3908 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3909 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
3910 end do
3911
3912 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
3913 & qv_l)
3914 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
3915 & qv_r)
3916
3917 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3918 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
3919
3920 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
3921 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
3922
3923 h_l = (e_l + pres_l)/rho_l
3924 h_r = (e_r + pres_r)/rho_r
3925
3926 if (avg_state == avg_state_roe) then
3927# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3928 rho_avg = sqrt(rho_l*rho_r)
3929# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3930
3931# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3932 vel_avg_rms = 0._wp
3933# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3934
3935# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3936
3937# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3938#if defined(MFC_OpenACC)
3939# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3940!$acc loop seq
3941# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3942#elif defined(MFC_OpenMP)
3943# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3944
3945# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3946#endif
3947# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3948 do i = 1, num_vels
3949# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3950 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
3951# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3952 end do
3953# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3954
3955# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3956 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3957# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3958
3959# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3960 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3961# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3962
3963# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3964 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
3965# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3966
3967# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3968 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3969# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3970
3971# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3972 if (chemistry) then
3973# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3974 eps = 0.001_wp
3975# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3976 call get_species_enthalpies_rt(t_l, h_il)
3977# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3978 call get_species_enthalpies_rt(t_r, h_ir)
3979# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3980 h_il = h_il*gas_constant/molecular_weights*t_l
3981# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3982 h_ir = h_ir*gas_constant/molecular_weights*t_r
3983# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3984 call get_species_specific_heats_r(t_l, cp_il)
3985# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3986 call get_species_specific_heats_r(t_r, cp_ir)
3987# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3988
3989# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3990 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3991# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3992 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3993# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3994 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3995# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3996 if (abs(t_l - t_r) < eps) then
3997# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
3998 ! Case when T_L and T_R are very close
3999# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4000 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
4001# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4002 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
4003# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4004 & - gas_constant/molecular_weights(:)))
4005# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4006 else
4007# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4008 ! Normal calculation when T_L and T_R are sufficiently different
4009# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4010 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
4011# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4012 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
4013# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4014 end if
4015# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4016 gamma_avg = cp_avg/cv_avg
4017# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4018
4019# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4020 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
4021# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4022 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
4023# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4024 end if
4025# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4026 end if
4027# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4028
4029# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4030 if (avg_state == avg_state_arithmetic) then
4031# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4032 rho_avg = 5.e-1_wp*(rho_l + rho_r)
4033# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4034 vel_avg_rms = 0._wp
4035# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4036
4037# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4038#if defined(MFC_OpenACC)
4039# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4040!$acc loop seq
4041# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4042#elif defined(MFC_OpenMP)
4043# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4044
4045# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4046#endif
4047# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4048 do i = 1, num_vels
4049# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4050 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
4051# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4052 end do
4053# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4054
4055# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4056 h_avg = 5.e-1_wp*(h_l + h_r)
4057# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4058 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
4059# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4060 qv_avg = 5.e-1_wp*(qv_l + qv_r)
4061# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4062 end if
4063
4064 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
4065 & c_l, qv_l)
4066
4067 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
4068 & c_r, qv_r)
4069
4070 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
4071 ! variables are placeholders to call the subroutine.
4072
4073 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
4074 & 0._wp, c_avg, qv_avg)
4075
4076 if (wave_speeds == wave_speeds_direct) then
4077 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
4078 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
4079
4080 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
4081 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
4082 & - rho_r*(s_r - vel_r(dir_idx(1))))
4083 else if (wave_speeds == wave_speeds_pressure) then
4084 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4085
4086 pres_sr = pres_sl
4087
4088 ! Low Mach correction: Thornber et al. JCP (2008)
4089 ms_l = max(1._wp, &
4090 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
4091 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
4092 ms_r = max(1._wp, &
4093 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
4094 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
4095
4096 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4097 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4098
4099 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4100 end if
4101
4102 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4103 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4104
4105 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4106 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4107 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4108 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4109 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4110
4111 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4112 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4113 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4114
4115
4116# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4117#if defined(MFC_OpenACC)
4118# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4119!$acc loop seq
4120# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4121#elif defined(MFC_OpenMP)
4122# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4123
4124# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4125#endif
4126 do i = 1, eqn_idx%cont%end
4127 flux_rsx_vf(j, k, l, &
4128 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
4129 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4130 end do
4131
4132 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4133
4134# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4135#if defined(MFC_OpenACC)
4136# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4137!$acc loop seq
4138# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4139#elif defined(MFC_OpenMP)
4140# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4141
4142# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4143#endif
4144 do i = 1, num_dims
4145 flux_rsx_vf(j, k, l, &
4146 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
4147 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4148 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
4149 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4150 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4151 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
4152 end do
4153
4154 if (bubbles_euler) then
4155 ! Put p_tilde in
4156
4157# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4158#if defined(MFC_OpenACC)
4159# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4160!$acc loop seq
4161# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4162#elif defined(MFC_OpenMP)
4163# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4164
4165# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4166#endif
4167 do i = 1, num_dims
4168 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
4169 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
4170 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
4171 end do
4172 end if
4173
4174 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
4175
4176
4177# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4178#if defined(MFC_OpenACC)
4179# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4180!$acc loop seq
4181# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4182#elif defined(MFC_OpenMP)
4183# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4184
4185# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4186#endif
4187 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
4188 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4189 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4190 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4191 end do
4192
4193 ! Advection velocity source: interface velocity for volume fraction transport
4194
4195# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4196#if defined(MFC_OpenACC)
4197# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4198!$acc loop seq
4199# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4200#elif defined(MFC_OpenMP)
4201# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4202
4203# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4204#endif
4205 do i = 1, num_dims
4206 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
4207 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
4208 end do
4209
4210 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4211
4212 ! Add advection flux for bubble variables
4213 if (bubbles_euler) then
4214
4215# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4216#if defined(MFC_OpenACC)
4217# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4218!$acc loop seq
4219# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4220#elif defined(MFC_OpenMP)
4221# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4222
4223# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4224#endif
4225 do i = eqn_idx%bub%beg, eqn_idx%bub%end
4226 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
4227 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4228 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, &
4229 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4230 end do
4231 end if
4232
4233 ! Geometrical source flux for cylindrical coordinates
4234
4235# 678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4236 if (cyl_coord) then
4237 ! Substituting the advective flux into the inviscid geometrical source flux
4238
4239# 680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4240#if defined(MFC_OpenACC)
4241# 680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4242!$acc loop seq
4243# 680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4244#elif defined(MFC_OpenMP)
4245# 680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4246
4247# 680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4248#endif
4249 do i = 1, eqn_idx%E
4250 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4251 end do
4252 ! Recalculating the radial momentum geometric source flux
4253 flux_gsrc_rsx_vf(j, k, l, &
4254 & eqn_idx%cont%end + dir_idx(1)) &
4255 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l(dir_idx(1)), &
4256 & vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, &
4257 & dir_flg(dir_idx(1)))
4258 ! Geometrical source of the void fraction(s) is zero
4259
4260# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4261#if defined(MFC_OpenACC)
4262# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4263!$acc loop seq
4264# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4265#elif defined(MFC_OpenMP)
4266# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4267
4268# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4269#endif
4270 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4271 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4272 end do
4273 end if
4274# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4275# 710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4276 end do
4277 end do
4278 end do
4279
4280# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4281#if defined(MFC_OpenACC)
4282# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4283!$acc end parallel loop
4284# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4285#elif defined(MFC_OpenMP)
4286# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4287
4288# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4289!$omp end target teams loop
4290# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4291#endif
4292 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
4293 ! 5-equation model with Euler-Euler bubble dynamics
4294
4295# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4296
4297# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4298#if defined(MFC_OpenACC)
4299# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4300!$acc parallel loop collapse(3) gang vector default(present) &
4301# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4302!$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, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, 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) &
4303# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4304!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
4305# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4306#elif defined(MFC_OpenMP)
4307# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4308
4309# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4310
4311# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4312
4313# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4314!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4315# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4316!$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, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, 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) &
4317# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4318!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
4319# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4320#endif
4321# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4322 do l = is3%beg, is3%end
4323 do k = is1%beg, is1%end
4324 do j = is2%beg, is2%end
4325 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4326 rho_l = 0._wp; rho_r = 0._wp
4327 gamma_l = 0._wp; gamma_r = 0._wp
4328 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4329 qv_l = 0._wp; qv_r = 0._wp
4330
4331
4332# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4333#if defined(MFC_OpenACC)
4334# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4335!$acc loop seq
4336# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4337#elif defined(MFC_OpenMP)
4338# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4339
4340# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4341#endif
4342 do i = 1, num_fluids
4343 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4344 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4345 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4346 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4347 end do
4348
4349 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4350
4351
4352# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4353#if defined(MFC_OpenACC)
4354# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4355!$acc loop seq
4356# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4357#elif defined(MFC_OpenMP)
4358# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4359
4360# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4361#endif
4362 do i = 1, num_dims
4363 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4364 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4365 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4366 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4367 end do
4368
4369 ! Retain this in the refactor
4370 if (mpp_lim .and. (num_fluids > 2)) then
4371 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, &
4372 & pi_inf_l, qv_l)
4373 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, &
4374 & pi_inf_r, qv_r)
4375 else if (num_fluids > 2) then
4376 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_l, alpha_l, rho_l, gamma_l, &
4377 & pi_inf_l, qv_l)
4378 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_r, alpha_r, rho_r, gamma_r, &
4379 & pi_inf_r, qv_r)
4380 else
4381 rho_l = ql_prim_rsx_vf(j, k, l, 1)
4382 gamma_l = gammas(1)
4383 pi_inf_l = pi_infs(1)
4384 qv_l = qvs(1)
4385 rho_r = qr_prim_rsx_vf(j, k + 1, l, 1)
4386 gamma_r = gammas(1)
4387 pi_inf_r = pi_infs(1)
4388 qv_r = qvs(1)
4389 end if
4390
4391 if (viscous) then
4392 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
4393
4394# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4395#if defined(MFC_OpenACC)
4396# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4397!$acc loop seq
4398# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4399#elif defined(MFC_OpenMP)
4400# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4401
4402# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4403#endif
4404 do i = 1, 2
4405 re_l(i) = dflt_real
4406 re_r(i) = dflt_real
4407
4408 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
4409 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
4410
4411
4412# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4413#if defined(MFC_OpenACC)
4414# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4415!$acc loop seq
4416# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4417#elif defined(MFC_OpenMP)
4418# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4419
4420# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4421#endif
4422 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
4423 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
4424 & q)))/res_gs(i, q) + re_l(i)
4425 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
4426 & q)))/res_gs(i, q) + re_r(i)
4427 end do
4428
4429 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4430 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4431 end do
4432 end if
4433 end if
4434
4435 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4436 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4437
4438 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
4439 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
4440
4441 h_l = (e_l + pres_l)/rho_l
4442 h_r = (e_r + pres_r)/rho_r
4443
4444 if (avg_state == avg_state_arithmetic) then
4445
4446# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4447#if defined(MFC_OpenACC)
4448# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4449!$acc loop seq
4450# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4451#elif defined(MFC_OpenMP)
4452# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4453
4454# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4455#endif
4456 do i = 1, nb
4457 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
4458 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
4459
4460 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
4461 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
4462 if (.not. polytropic .and. .not. qbmm) then
4463 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
4464 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
4465 end if
4466 end do
4467
4468 if (.not. qbmm) then
4469 if (adv_n) then
4470 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
4471 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
4472 else
4473 nbub_l = 0._wp
4474 nbub_r = 0._wp
4475
4476# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4477#if defined(MFC_OpenACC)
4478# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4479!$acc loop seq
4480# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4481#elif defined(MFC_OpenMP)
4482# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4483
4484# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4485#endif
4486 do i = 1, nb
4487 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
4488 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
4489 end do
4490
4491 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
4492 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
4493 & eqn_idx%E + num_fluids)/nbub_r
4494 end if
4495 else
4496 ! nb stored in 0th moment of first R0 bin in variable conversion module
4497 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
4498 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
4499 end if
4500
4501
4502# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4503#if defined(MFC_OpenACC)
4504# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4505!$acc loop seq
4506# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4507#elif defined(MFC_OpenMP)
4508# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4509
4510# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4511#endif
4512 do i = 1, nb
4513 if (.not. qbmm) then
4514 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
4515 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
4516 end if
4517 end do
4518
4519 if (qbmm) then
4520 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
4521 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
4522
4523 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
4524 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
4525
4526 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
4527 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
4528 else
4529 pbwr3lbar = 0._wp
4530 pbwr3rbar = 0._wp
4531
4532 r3lbar = 0._wp
4533 r3rbar = 0._wp
4534
4535 r3v2lbar = 0._wp
4536 r3v2rbar = 0._wp
4537
4538
4539# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4540#if defined(MFC_OpenACC)
4541# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4542!$acc loop seq
4543# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4544#elif defined(MFC_OpenMP)
4545# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4546
4547# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4548#endif
4549 do i = 1, nb
4550 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
4551 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
4552
4553 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
4554 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
4555
4556 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
4557 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
4558 end do
4559 end if
4560
4561 rho_avg = 5.e-1_wp*(rho_l + rho_r)
4562 h_avg = 5.e-1_wp*(h_l + h_r)
4563 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
4564 qv_avg = 5.e-1_wp*(qv_l + qv_r)
4565 vel_avg_rms = 0._wp
4566
4567
4568# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4569#if defined(MFC_OpenACC)
4570# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4571!$acc loop seq
4572# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4573#elif defined(MFC_OpenMP)
4574# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4575
4576# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4577#endif
4578 do i = 1, num_dims
4579 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
4580 end do
4581 end if
4582
4583 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
4584 & c_l, qv_l)
4585
4586 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
4587 & c_r, qv_r)
4588
4589 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
4590 ! variables are placeholders to call the subroutine.
4591 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
4592 & 0._wp, c_avg, qv_avg)
4593
4594 if (viscous) then
4595
4596# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4597#if defined(MFC_OpenACC)
4598# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4599!$acc loop seq
4600# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4601#elif defined(MFC_OpenMP)
4602# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4603
4604# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4605#endif
4606 do i = 1, 2
4607 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
4608 end do
4609 end if
4610
4611 ! Low Mach correction
4612 if (low_mach == 2) then
4613 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
4614# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4615 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4616# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4617 pcorr = 0._wp
4618# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4619
4620# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4621 if (low_mach == 1) then
4622# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4623 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4624# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4625 end if
4626# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4627 else if (riemann_solver == riemann_solver_hllc) then
4628# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4629 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4630# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4631 pcorr = 0._wp
4632# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4633
4634# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4635 if (low_mach == 1) then
4636# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4637 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))) &
4638# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4639 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4640# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4641 else if (low_mach == 2) then
4642# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4643 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))))
4644# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4645 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))))
4646# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4647 vel_l(dir_idx(1)) = vel_l_tmp
4648# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4649 vel_r(dir_idx(1)) = vel_r_tmp
4650# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4651 end if
4652# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4653 end if
4654 end if
4655
4656 if (wave_speeds == wave_speeds_direct) then
4657 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
4658 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
4659
4660 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
4661 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
4662 & - rho_r*(s_r - vel_r(dir_idx(1))))
4663 else if (wave_speeds == wave_speeds_pressure) then
4664 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4665
4666 pres_sr = pres_sl
4667
4668 ! Low Mach correction: Thornber et al. JCP (2008)
4669 ms_l = max(1._wp, &
4670 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
4671 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
4672 ms_r = max(1._wp, &
4673 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
4674 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
4675
4676 s_l = vel_l(dir_idx(1)) - c_l*ms_l
4677 s_r = vel_r(dir_idx(1)) + c_r*ms_r
4678
4679 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
4680 end if
4681
4682 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
4683 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
4684
4685 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
4686 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4687 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4688 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
4689 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
4690
4691 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
4692 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
4693 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
4694
4695 ! Low Mach correction
4696 if (low_mach == 1) then
4697 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
4698# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4699 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4700# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4701 pcorr = 0._wp
4702# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4703
4704# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4705 if (low_mach == 1) then
4706# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4707 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4708# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4709 end if
4710# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4711 else if (riemann_solver == riemann_solver_hllc) then
4712# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4713 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4714# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4715 pcorr = 0._wp
4716# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4717
4718# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4719 if (low_mach == 1) then
4720# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4721 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))) &
4722# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4723 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4724# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4725 else if (low_mach == 2) then
4726# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4727 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))))
4728# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4729 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))))
4730# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4731 vel_l(dir_idx(1)) = vel_l_tmp
4732# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4733 vel_r(dir_idx(1)) = vel_r_tmp
4734# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4735 end if
4736# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4737 end if
4738 else
4739 pcorr = 0._wp
4740 end if
4741
4742
4743# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4744#if defined(MFC_OpenACC)
4745# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4746!$acc loop seq
4747# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4748#elif defined(MFC_OpenMP)
4749# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4750
4751# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4752#endif
4753 do i = 1, eqn_idx%cont%end
4754 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4755 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4756 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4757 end do
4758
4759 if (bubbles_euler .and. (num_fluids > 1)) then
4760 ! Kill mass transport @ gas density
4761 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
4762 end if
4763
4764 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
4765
4766 ! Include p_tilde
4767
4768 if (avg_state == avg_state_arithmetic) then
4769 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
4770 pres_l = pres_l - alpha_l(num_fluids)*pres_l
4771 else
4772 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
4773 end if
4774
4775 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
4776 pres_r = pres_r - alpha_r(num_fluids)*pres_r
4777 else
4778 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
4779 end if
4780 end if
4781
4782
4783# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4784#if defined(MFC_OpenACC)
4785# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4786!$acc loop seq
4787# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4788#elif defined(MFC_OpenMP)
4789# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4790
4791# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4792#endif
4793 do i = 1, num_dims
4794 flux_rsx_vf(j, k, l, &
4795 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
4796 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4797 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
4798 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4799 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
4800 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
4801 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
4802 end do
4803
4804 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
4805 flux_rsx_vf(j, k, l, &
4806 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
4807 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
4808 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
4809 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
4810 & *pcorr*s_s
4811
4812 ! Volume fraction flux
4813
4814# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4815#if defined(MFC_OpenACC)
4816# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4817!$acc loop seq
4818# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4819#elif defined(MFC_OpenMP)
4820# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4821
4822# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4823#endif
4824 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4825 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
4826 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
4827 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4828 end do
4829
4830 ! Advection velocity source: interface velocity for volume fraction transport
4831
4832# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4833#if defined(MFC_OpenACC)
4834# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4835!$acc loop seq
4836# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4837#elif defined(MFC_OpenMP)
4838# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4839
4840# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4841#endif
4842 do i = 1, num_dims
4843 vel_src_rsx_vf(j, k, l, &
4844 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
4845 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
4846
4847 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
4848 end do
4849
4850 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
4851
4852 ! Add advection flux for bubble variables
4853
4854# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4855#if defined(MFC_OpenACC)
4856# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4857!$acc loop seq
4858# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4859#elif defined(MFC_OpenMP)
4860# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4861
4862# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4863#endif
4864 do i = eqn_idx%bub%beg, eqn_idx%bub%end
4865 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
4866 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4867 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4868 end do
4869
4870 if (qbmm) then
4871 flux_rsx_vf(j, k, l, &
4872 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4873 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4874 end if
4875
4876 if (adv_n) then
4877 flux_rsx_vf(j, k, l, &
4878 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
4879 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
4880 end if
4881
4882 ! Geometrical source flux for cylindrical coordinates
4883# 1057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4884 if (cyl_coord) then
4885 ! Substituting the advective flux into the inviscid geometrical source flux
4886
4887# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4888#if defined(MFC_OpenACC)
4889# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4890!$acc loop seq
4891# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4892#elif defined(MFC_OpenMP)
4893# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4894
4895# 1059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4896#endif
4897 do i = 1, eqn_idx%E
4898 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
4899 end do
4900 ! Recalculating the radial momentum geometric source flux
4901 flux_gsrc_rsx_vf(j, k, l, &
4902 & eqn_idx%cont%end + dir_idx(1)) &
4903 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l(dir_idx(1)), &
4904 & vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, &
4905 & dir_flg(dir_idx(1)))
4906 ! Geometrical source of the void fraction(s) is zero
4907
4908# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4909#if defined(MFC_OpenACC)
4910# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4911!$acc loop seq
4912# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4913#elif defined(MFC_OpenMP)
4914# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4915
4916# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4917#endif
4918 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4919 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
4920 end do
4921 end if
4922# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4923# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4924 end do
4925 end do
4926 end do
4927
4928# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4929#if defined(MFC_OpenACC)
4930# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4931!$acc end parallel loop
4932# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4933#elif defined(MFC_OpenMP)
4934# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4935
4936# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4937!$omp end target teams loop
4938# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4939#endif
4940 else
4941 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
4942
4943# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4944
4945# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4946#if defined(MFC_OpenACC)
4947# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4948!$acc parallel loop collapse(3) gang vector default(present) &
4949# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4950!$acc& private(i, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, 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, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, 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) &
4951# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4952!$acc& firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
4953# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4954#elif defined(MFC_OpenMP)
4955# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4956
4957# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4958
4959# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4960
4961# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4962!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4963# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4964!$omp& private(i, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, 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, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, 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) &
4965# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4966!$omp& firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
4967# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4968#endif
4969# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4970 do l = is3%beg, is3%end
4971 do k = is1%beg, is1%end
4972 do j = is2%beg, is2%end
4973 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4974 rho_l = 0._wp; rho_r = 0._wp
4975 gamma_l = 0._wp; gamma_r = 0._wp
4976 pi_inf_l = 0._wp; pi_inf_r = 0._wp
4977 qv_l = 0._wp; qv_r = 0._wp
4978 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
4979
4980
4981# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4982#if defined(MFC_OpenACC)
4983# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4984!$acc loop seq
4985# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4986#elif defined(MFC_OpenMP)
4987# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4988
4989# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4990#endif
4991 do i = 1, num_fluids
4992 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4993 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4994 end do
4995
4996
4997# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
4998#if defined(MFC_OpenACC)
4999# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5000!$acc loop seq
5001# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5002#elif defined(MFC_OpenMP)
5003# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5004
5005# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5006#endif
5007 do i = 1, num_dims
5008 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5009 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
5010 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5011 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5012 end do
5013
5014 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5015 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
5016
5017 ! Change this by splitting it into the cases present in the bubbles_euler
5018 if (mpp_lim) then
5019
5020# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5021#if defined(MFC_OpenACC)
5022# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5023!$acc loop seq
5024# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5025#elif defined(MFC_OpenMP)
5026# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5027
5028# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5029#endif
5030 do i = 1, num_fluids
5031 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5032 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5033 & eqn_idx%E + i)), 1._wp)
5034 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
5035 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
5036 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
5037 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5038 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5039 end do
5040
5041
5042# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5043#if defined(MFC_OpenACC)
5044# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5045!$acc loop seq
5046# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5047#elif defined(MFC_OpenMP)
5048# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5049
5050# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5051#endif
5052 do i = 1, num_fluids
5053 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5054 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5055 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
5056 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5057 end do
5058 end if
5059
5060 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
5061 ! downstream
5062
5063# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5064#if defined(MFC_OpenACC)
5065# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5066!$acc loop seq
5067# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5068#elif defined(MFC_OpenMP)
5069# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5070
5071# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5072#endif
5073 do i = 1, num_fluids
5074 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5075 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
5076 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5077 alpha_lim_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
5078 end do
5079
5080 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
5081 & pi_inf_l, qv_l)
5082 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
5083 & pi_inf_r, qv_r)
5084
5085 if (viscous) then
5086 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
5087 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
5088 end if
5089
5090 if (chemistry) then
5091 c_sum_yi_phi = 0.0_wp
5092
5093# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5094#if defined(MFC_OpenACC)
5095# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5096!$acc loop seq
5097# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5098#elif defined(MFC_OpenMP)
5099# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5100
5101# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5102#endif
5103 do i = eqn_idx%species%beg, eqn_idx%species%end
5104 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5105 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
5106 end do
5107
5108 call get_mixture_molecular_weight(ys_l, mw_l)
5109 call get_mixture_molecular_weight(ys_r, mw_r)
5110
5111 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5112 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5113
5114 r_gas_l = gas_constant/mw_l
5115 r_gas_r = gas_constant/mw_r
5116
5117 t_l = pres_l/rho_l/r_gas_l
5118 t_r = pres_r/rho_r/r_gas_r
5119
5120 call get_species_specific_heats_r(t_l, cp_il)
5121 call get_species_specific_heats_r(t_r, cp_ir)
5122
5123 if (chem_params%gamma_method == 1) then
5124 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5125 gamma_il = cp_il/(cp_il - 1.0_wp)
5126 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5127
5128 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5129 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5130 else if (chem_params%gamma_method == 2) then
5131 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5132 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5133 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5134 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5135 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5136
5137 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
5138 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5139 end if
5140
5141 call get_mixture_energy_mass(t_l, ys_l, e_l)
5142 call get_mixture_energy_mass(t_r, ys_r, e_r)
5143
5144 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5145 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5146 h_l = (e_l + pres_l)/rho_l
5147 h_r = (e_r + pres_r)/rho_r
5148 else
5149 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5150 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5151
5152 h_l = (e_l + pres_l)/rho_l
5153 h_r = (e_r + pres_r)/rho_r
5154 end if
5155
5156 ! Hyperelastic stress contribution: strain energy added to total energy
5157 if (hyperelasticity) then
5158
5159# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5160#if defined(MFC_OpenACC)
5161# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5162!$acc loop seq
5163# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5164#elif defined(MFC_OpenMP)
5165# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5166
5167# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5168#endif
5169 do i = 1, num_dims
5170 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
5171 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
5172 end do
5173 g_l = 0._wp
5174 g_r = 0._wp
5175
5176# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5177#if defined(MFC_OpenACC)
5178# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5179!$acc loop seq
5180# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5181#elif defined(MFC_OpenMP)
5182# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5183
5184# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5185#endif
5186 do i = 1, num_fluids
5187 ! Mixture left and right shear modulus
5188 g_l = g_l + alpha_l(i)*gs_rs(i)
5189 g_r = g_r + alpha_r(i)*gs_rs(i)
5190 end do
5191 ! Elastic contribution to energy if G large enough
5192 if (g_l > verysmall .and. g_r > verysmall) then
5193 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
5194 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
5195 end if
5196
5197# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5198#if defined(MFC_OpenACC)
5199# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5200!$acc loop seq
5201# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5202#elif defined(MFC_OpenMP)
5203# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5204
5205# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5206#endif
5207 do i = 1, b_size - 1
5208 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5209 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
5210 end do
5211 end if
5212
5213 h_l = (e_l + pres_l)/rho_l
5214 h_r = (e_r + pres_r)/rho_r
5215
5216 if (avg_state == avg_state_roe) then
5217# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5218 rho_avg = sqrt(rho_l*rho_r)
5219# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5220
5221# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5222 vel_avg_rms = 0._wp
5223# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5224
5225# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5226
5227# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5228#if defined(MFC_OpenACC)
5229# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5230!$acc loop seq
5231# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5232#elif defined(MFC_OpenMP)
5233# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5234
5235# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5236#endif
5237# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5238 do i = 1, num_vels
5239# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5240 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
5241# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5242 end do
5243# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5244
5245# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5246 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
5247# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5248
5249# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5250 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
5251# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5252
5253# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5254 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
5255# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5256
5257# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5258 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
5259# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5260
5261# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5262 if (chemistry) then
5263# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5264 eps = 0.001_wp
5265# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5266 call get_species_enthalpies_rt(t_l, h_il)
5267# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5268 call get_species_enthalpies_rt(t_r, h_ir)
5269# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5270 h_il = h_il*gas_constant/molecular_weights*t_l
5271# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5272 h_ir = h_ir*gas_constant/molecular_weights*t_r
5273# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5274 call get_species_specific_heats_r(t_l, cp_il)
5275# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5276 call get_species_specific_heats_r(t_r, cp_ir)
5277# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5278
5279# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5280 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
5281# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5282 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
5283# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5284 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
5285# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5286 if (abs(t_l - t_r) < eps) then
5287# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5288 ! Case when T_L and T_R are very close
5289# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5290 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
5291# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5292 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
5293# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5294 & - gas_constant/molecular_weights(:)))
5295# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5296 else
5297# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5298 ! Normal calculation when T_L and T_R are sufficiently different
5299# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5300 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
5301# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5302 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
5303# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5304 end if
5305# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5306 gamma_avg = cp_avg/cv_avg
5307# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5308
5309# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5310 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
5311# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5312 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
5313# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5314 end if
5315# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5316 end if
5317# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5318
5319# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5320 if (avg_state == avg_state_arithmetic) then
5321# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5322 rho_avg = 5.e-1_wp*(rho_l + rho_r)
5323# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5324 vel_avg_rms = 0._wp
5325# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5326
5327# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5328#if defined(MFC_OpenACC)
5329# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5330!$acc loop seq
5331# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5332#elif defined(MFC_OpenMP)
5333# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5334
5335# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5336#endif
5337# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5338 do i = 1, num_vels
5339# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5340 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
5341# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5342 end do
5343# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5344
5345# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5346 h_avg = 5.e-1_wp*(h_l + h_r)
5347# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5348 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
5349# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5350 qv_avg = 5.e-1_wp*(qv_l + qv_r)
5351# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5352 end if
5353
5354 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
5355 & c_l, qv_l)
5356
5357 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
5358 & c_r, qv_r)
5359
5360 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
5361 ! variables are placeholders to call the subroutine.
5362 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
5363 & c_sum_yi_phi, c_avg, qv_avg)
5364
5365 if (viscous) then
5366 if (chemistry) then
5367 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
5368 end if
5369
5370# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5371#if defined(MFC_OpenACC)
5372# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5373!$acc loop seq
5374# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5375#elif defined(MFC_OpenMP)
5376# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5377
5378# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5379#endif
5380 do i = 1, 2
5381 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
5382 end do
5383 end if
5384
5385 ! Low Mach correction
5386 if (low_mach == 2) then
5387 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5388# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5389 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5390# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5391 pcorr = 0._wp
5392# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5393
5394# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5395 if (low_mach == 1) then
5396# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5397 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5398# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5399 end if
5400# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5401 else if (riemann_solver == riemann_solver_hllc) then
5402# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5403 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5404# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5405 pcorr = 0._wp
5406# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5407
5408# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5409 if (low_mach == 1) then
5410# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5411 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))) &
5412# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5413 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5414# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5415 else if (low_mach == 2) then
5416# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5417 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))))
5418# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5419 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))))
5420# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5421 vel_l(dir_idx(1)) = vel_l_tmp
5422# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5423 vel_r(dir_idx(1)) = vel_r_tmp
5424# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5425 end if
5426# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5427 end if
5428 end if
5429
5430 if (wave_speeds == wave_speeds_direct) then
5431 if (elasticity) then
5432 ! Elastic wave speed, Rodriguez et al. JCP (2019)
5433 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) &
5434 & ))/rho_l), &
5435 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
5436 & + tau_e_r(dir_idx_tau(1)))/rho_r))
5437 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) &
5438 & ))/rho_r), &
5439 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
5440 & + tau_e_l(dir_idx_tau(1)))/rho_l))
5441 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
5442 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
5443 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
5444 & - vel_r(dir_idx(1))))
5445 else
5446 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
5447 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
5448 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
5449 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
5450 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
5451 end if
5452 else if (wave_speeds == wave_speeds_pressure) then
5453 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5454
5455 pres_sr = pres_sl
5456
5457 ! Low Mach correction: Thornber et al. JCP (2008)
5458 ms_l = max(1._wp, &
5459 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
5460 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
5461 ms_r = max(1._wp, &
5462 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
5463 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
5464
5465 s_l = vel_l(dir_idx(1)) - c_l*ms_l
5466 s_r = vel_r(dir_idx(1)) + c_r*ms_r
5467
5468 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
5469 end if
5470
5471 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
5472 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
5473
5474 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
5475 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5476 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5477 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
5478 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
5479 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
5480
5481 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
5482 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
5483 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
5484
5485 ! Low Mach correction
5486 if (low_mach == 1) then
5487 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
5488# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5489 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5490# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5491 pcorr = 0._wp
5492# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5493
5494# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5495 if (low_mach == 1) then
5496# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5497 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5498# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5499 end if
5500# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5501 else if (riemann_solver == riemann_solver_hllc) then
5502# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5503 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5504# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5505 pcorr = 0._wp
5506# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5507
5508# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5509 if (low_mach == 1) then
5510# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5511 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))) &
5512# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5513 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5514# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5515 else if (low_mach == 2) then
5516# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5517 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))))
5518# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5519 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))))
5520# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5521 vel_l(dir_idx(1)) = vel_l_tmp
5522# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5523 vel_r(dir_idx(1)) = vel_r_tmp
5524# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5525 end if
5526# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5527 end if
5528 else
5529 pcorr = 0._wp
5530 end if
5531
5532 ! COMPUTING THE HLLC FLUXES MASS FLUX.
5533
5534# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5535#if defined(MFC_OpenACC)
5536# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5537!$acc loop seq
5538# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5539#elif defined(MFC_OpenMP)
5540# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5541
5542# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5543#endif
5544 do i = 1, eqn_idx%cont%end
5545 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5546 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5547 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5548 end do
5549
5550 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
5551 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
5552
5553# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5554#if defined(MFC_OpenACC)
5555# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5556!$acc loop seq
5557# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5558#elif defined(MFC_OpenMP)
5559# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5560
5561# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5562#endif
5563 do i = 1, num_dims
5564 flux_rsx_vf(j, k, l, &
5565 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
5566 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
5567 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
5568 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
5569 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
5570 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
5571 end do
5572
5573 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
5574 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
5575 flux_rsx_vf(j, k, l, &
5576 & 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 &
5577 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
5578 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
5579 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
5580 & *(s_p/s_r)*pcorr*s_s
5581
5582 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
5583 if (elasticity) then
5584 flux_ene_e = 0._wp
5585
5586# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5587#if defined(MFC_OpenACC)
5588# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5589!$acc loop seq
5590# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5591#elif defined(MFC_OpenMP)
5592# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5593
5594# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5595#endif
5596 do i = 1, num_dims
5597 ! MOMENTUM ELASTIC FLUX.
5598 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
5599 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
5600 & - xi_p*tau_e_r(dir_idx_tau(i))
5601 ! ENERGY ELASTIC FLUX.
5602 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
5603 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
5604 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
5605 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
5606 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
5607 end do
5608 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
5609 end if
5610
5611 ! VOLUME FRACTION FLUX.
5612
5613# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5614#if defined(MFC_OpenACC)
5615# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5616!$acc loop seq
5617# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5618#elif defined(MFC_OpenMP)
5619# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5620
5621# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5622#endif
5623 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5624 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
5625 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
5626 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5627 end do
5628
5629 ! VOLUME FRACTION SOURCE FLUX.
5630
5631# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5632#if defined(MFC_OpenACC)
5633# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5634!$acc loop seq
5635# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5636#elif defined(MFC_OpenMP)
5637# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5638
5639# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5640#endif
5641 do i = 1, num_dims
5642 vel_src_rsx_vf(j, k, l, &
5643 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
5644 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
5645 end do
5646
5647 ! COLOR FUNCTION FLUX
5648 if (surface_tension) then
5649 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
5650 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5651 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5652 end if
5653
5654 ! Hyperelastic reference map flux for material deformation tracking
5655 if (hyperelasticity) then
5656
5657# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5658#if defined(MFC_OpenACC)
5659# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5660!$acc loop seq
5661# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5662#elif defined(MFC_OpenMP)
5663# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5664
5665# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5666#endif
5667 do i = 1, num_dims
5668 flux_rsx_vf(j, k, l, &
5669 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
5670 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
5671 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
5672 end do
5673 end if
5674
5675 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
5676
5677 if (chemistry) then
5678
5679# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5680#if defined(MFC_OpenACC)
5681# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5682!$acc loop seq
5683# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5684#elif defined(MFC_OpenMP)
5685# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5686
5687# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5688#endif
5689 do i = eqn_idx%species%beg, eqn_idx%species%end
5690 y_l = ql_prim_rsx_vf(j, k, l, i)
5691 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5692
5693 flux_rsx_vf(j, k, l, &
5694 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
5695 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
5696 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
5697 end do
5698 end if
5699
5700 ! Geometrical source flux for cylindrical coordinates
5701# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5702 if (cyl_coord) then
5703 ! Substituting the advective flux into the inviscid geometrical source flux
5704
5705# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5706#if defined(MFC_OpenACC)
5707# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5708!$acc loop seq
5709# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5710#elif defined(MFC_OpenMP)
5711# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5712
5713# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5714#endif
5715 do i = 1, eqn_idx%E
5716 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5717 end do
5718 ! Recalculating the radial momentum geometric source flux
5719 flux_gsrc_rsx_vf(j, k, l, &
5720 & eqn_idx%cont%end + dir_idx(1)) &
5721 & = f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l(dir_idx(1)), &
5722 & vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, &
5723 & dir_flg(dir_idx(1)))
5724 ! Geometrical source of the void fraction(s) is zero
5725
5726# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5727#if defined(MFC_OpenACC)
5728# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5729!$acc loop seq
5730# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5731#elif defined(MFC_OpenMP)
5732# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5733
5734# 1464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5735#endif
5736 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5737 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
5738 end do
5739 end if
5740# 1470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5741# 1484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5742 end do
5743 end do
5744 end do
5745
5746# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5747#if defined(MFC_OpenACC)
5748# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5749!$acc end parallel loop
5750# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5751#elif defined(MFC_OpenMP)
5752# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5753
5754# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5755!$omp end target teams loop
5756# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5757#endif
5758 end if
5759 end if
5760# 140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5761# 141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5762# 142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5763 if (norm_dir == 3) then
5764 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
5765 if (model_eqns == model_eqns_6eq) then
5766 ! 6-equation model (model_eqns=3): separate phasic internal energies
5767
5768# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5769
5770# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5771#if defined(MFC_OpenACC)
5772# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5773!$acc parallel loop collapse(3) gang vector default(present) &
5774# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5775!$acc& private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, 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) &
5776# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5777!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
5778# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5779#elif defined(MFC_OpenMP)
5780# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5781
5782# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5783
5784# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5785
5786# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5787!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5788# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5789!$omp& private(i, j, k, l, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, alpha_rho_L, alpha_rho_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, 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) &
5790# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5791!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
5792# 146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5793#endif
5794# 157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5795 do l = is1%beg, is1%end
5796 do k = is2%beg, is2%end
5797 do j = is3%beg, is3%end
5798 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5799 rho_l = 0._wp; rho_r = 0._wp
5800 gamma_l = 0._wp; gamma_r = 0._wp
5801 pi_inf_l = 0._wp; pi_inf_r = 0._wp
5802 qv_l = 0._wp; qv_r = 0._wp
5803 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
5804
5805
5806# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5807#if defined(MFC_OpenACC)
5808# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5809!$acc loop seq
5810# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5811#elif defined(MFC_OpenMP)
5812# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5813
5814# 167 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5815#endif
5816 do i = 1, num_dims
5817 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5818 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
5819 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5820 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5821 end do
5822
5823 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5824 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
5825
5826 rho_l = 0._wp
5827 gamma_l = 0._wp
5828 pi_inf_l = 0._wp
5829 qv_l = 0._wp
5830
5831 rho_r = 0._wp
5832 gamma_r = 0._wp
5833 pi_inf_r = 0._wp
5834 qv_r = 0._wp
5835
5836 alpha_l_sum = 0._wp
5837 alpha_r_sum = 0._wp
5838
5839 if (mpp_lim) then
5840
5841# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5842#if defined(MFC_OpenACC)
5843# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5844!$acc loop seq
5845# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5846#elif defined(MFC_OpenMP)
5847# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5848
5849# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5850#endif
5851 do i = 1, num_fluids
5852 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
5853 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
5854 & eqn_idx%E + i)), 1._wp)
5855 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5856 end do
5857
5858
5859# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5860#if defined(MFC_OpenACC)
5861# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5862!$acc loop seq
5863# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5864#elif defined(MFC_OpenMP)
5865# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5866
5867# 200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5868#endif
5869 do i = 1, num_fluids
5870 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
5871 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
5872 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
5873 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
5874 end do
5875
5876
5877# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5878#if defined(MFC_OpenACC)
5879# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5880!$acc loop seq
5881# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5882#elif defined(MFC_OpenMP)
5883# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5884
5885# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5886#endif
5887 do i = 1, num_fluids
5888 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
5889 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
5890 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
5891 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
5892 end do
5893 end if
5894
5895
5896# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5897#if defined(MFC_OpenACC)
5898# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5899!$acc loop seq
5900# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5901#elif defined(MFC_OpenMP)
5902# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5903
5904# 217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5905#endif
5906 do i = 1, num_fluids
5907 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5908 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
5909 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
5910 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
5911 end do
5912
5913 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
5914 & qv_l)
5915 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
5916 & qv_r)
5917
5918 if (viscous) then
5919 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
5920 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
5921 end if
5922
5923 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
5924 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
5925
5926 ! Hyperelastic stress contribution: strain energy added to total energy
5927 if (hyperelasticity) then
5928
5929# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5930#if defined(MFC_OpenACC)
5931# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5932!$acc loop seq
5933# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5934#elif defined(MFC_OpenMP)
5935# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5936
5937# 240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5938#endif
5939 do i = 1, num_dims
5940 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
5941 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
5942 end do
5943 g_l = 0._wp; g_r = 0._wp
5944
5945# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5946#if defined(MFC_OpenACC)
5947# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5948!$acc loop seq
5949# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5950#elif defined(MFC_OpenMP)
5951# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5952
5953# 246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5954#endif
5955 do i = 1, num_fluids
5956 ! Mixture left and right shear modulus
5957 g_l = g_l + alpha_l(i)*gs_rs(i)
5958 g_r = g_r + alpha_r(i)*gs_rs(i)
5959 end do
5960 ! Elastic contribution to energy if G large enough
5961 if (g_l > verysmall .and. g_r > verysmall) then
5962 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
5963 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
5964 end if
5965
5966# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5967#if defined(MFC_OpenACC)
5968# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5969!$acc loop seq
5970# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5971#elif defined(MFC_OpenMP)
5972# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5973
5974# 257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5975#endif
5976 do i = 1, b_size - 1
5977 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5978 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
5979 end do
5980 end if
5981
5982 h_l = (e_l + pres_l)/rho_l
5983 h_r = (e_r + pres_r)/rho_r
5984
5985 if (avg_state == avg_state_roe) then
5986# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5987 rho_avg = sqrt(rho_l*rho_r)
5988# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5989
5990# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5991 vel_avg_rms = 0._wp
5992# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5993
5994# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5995
5996# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5997#if defined(MFC_OpenACC)
5998# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
5999!$acc loop seq
6000# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6001#elif defined(MFC_OpenMP)
6002# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6003
6004# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6005#endif
6006# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6007 do i = 1, num_vels
6008# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6009 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
6010# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6011 end do
6012# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6013
6014# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6015 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6016# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6017
6018# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6019 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6020# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6021
6022# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6023 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
6024# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6025
6026# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6027 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6028# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6029
6030# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6031 if (chemistry) then
6032# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6033 eps = 0.001_wp
6034# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6035 call get_species_enthalpies_rt(t_l, h_il)
6036# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6037 call get_species_enthalpies_rt(t_r, h_ir)
6038# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6039 h_il = h_il*gas_constant/molecular_weights*t_l
6040# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6041 h_ir = h_ir*gas_constant/molecular_weights*t_r
6042# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6043 call get_species_specific_heats_r(t_l, cp_il)
6044# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6045 call get_species_specific_heats_r(t_r, cp_ir)
6046# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6047
6048# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6049 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6050# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6051 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6052# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6053 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6054# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6055 if (abs(t_l - t_r) < eps) then
6056# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6057 ! Case when T_L and T_R are very close
6058# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6059 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6060# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6061 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6062# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6063 & - gas_constant/molecular_weights(:)))
6064# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6065 else
6066# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6067 ! Normal calculation when T_L and T_R are sufficiently different
6068# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6069 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6070# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6071 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6072# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6073 end if
6074# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6075 gamma_avg = cp_avg/cv_avg
6076# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6077
6078# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6079 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6080# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6081 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6082# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6083 end if
6084# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6085 end if
6086# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6087
6088# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6089 if (avg_state == avg_state_arithmetic) then
6090# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6091 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6092# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6093 vel_avg_rms = 0._wp
6094# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6095
6096# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6097#if defined(MFC_OpenACC)
6098# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6099!$acc loop seq
6100# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6101#elif defined(MFC_OpenMP)
6102# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6103
6104# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6105#endif
6106# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6107 do i = 1, num_vels
6108# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6109 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6110# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6111 end do
6112# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6113
6114# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6115 h_avg = 5.e-1_wp*(h_l + h_r)
6116# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6117 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6118# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6119 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6120# 267 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6121 end if
6122
6123 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6124 & c_l, qv_l)
6125
6126 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6127 & c_r, qv_r)
6128
6129 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6130 ! variables are placeholders to call the subroutine.
6131 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6132 & 0._wp, c_avg, qv_avg)
6133
6134 if (viscous) then
6135
6136# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6137#if defined(MFC_OpenACC)
6138# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6139!$acc loop seq
6140# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6141#elif defined(MFC_OpenMP)
6142# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6143
6144# 281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6145#endif
6146 do i = 1, 2
6147 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6148 end do
6149 end if
6150
6151 ! Low Mach correction
6152 if (low_mach == 2) then
6153 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6154# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6155 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6156# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6157 pcorr = 0._wp
6158# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6159
6160# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6161 if (low_mach == 1) then
6162# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6163 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6164# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6165 end if
6166# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6167 else if (riemann_solver == riemann_solver_hllc) then
6168# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6169 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6170# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6171 pcorr = 0._wp
6172# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6173
6174# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6175 if (low_mach == 1) then
6176# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6177 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))) &
6178# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6179 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6180# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6181 else if (low_mach == 2) then
6182# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6183 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))))
6184# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6185 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))))
6186# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6187 vel_l(dir_idx(1)) = vel_l_tmp
6188# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6189 vel_r(dir_idx(1)) = vel_r_tmp
6190# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6191 end if
6192# 289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6193 end if
6194 end if
6195
6196 ! COMPUTING THE DIRECT WAVE SPEEDS
6197 if (wave_speeds == wave_speeds_direct) then
6198 if (elasticity) then
6199 ! Elastic wave speed, Rodriguez et al. JCP (2019)
6200 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) &
6201 & ))/rho_l), &
6202 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
6203 & + tau_e_r(dir_idx_tau(1)))/rho_r))
6204 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) &
6205 & ))/rho_r), &
6206 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
6207 & + tau_e_l(dir_idx_tau(1)))/rho_l))
6208 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
6209 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
6210 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
6211 & - vel_r(dir_idx(1))))
6212 else
6213 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6214 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6215 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6216 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
6217 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
6218 end if
6219 else if (wave_speeds == wave_speeds_pressure) then
6220 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6221
6222 pres_sr = pres_sl
6223
6224 ! Low Mach correction: Thornber et al. JCP (2008)
6225 ms_l = max(1._wp, &
6226 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
6227 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
6228 ms_r = max(1._wp, &
6229 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
6230 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
6231
6232 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6233 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6234
6235 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6236 end if
6237
6238 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6239 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6240
6241 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6242 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6243 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6244 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6245 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6246
6247 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6248 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
6249 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
6250
6251 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
6252 xi_mp = -min(0._wp, sign(1._wp, s_l))
6253 xi_pp = max(0._wp, sign(1._wp, s_r))
6254
6255 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 &
6256 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
6257 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
6258 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
6259 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
6260
6261 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))
6262
6263 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 &
6264 & - vel_r(dir_idx(1)))
6265
6266 ! Low Mach correction
6267 if (low_mach == 1) then
6268 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
6269# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6270 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6271# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6272 pcorr = 0._wp
6273# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6274
6275# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6276 if (low_mach == 1) then
6277# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6278 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6279# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6280 end if
6281# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6282 else if (riemann_solver == riemann_solver_hllc) then
6283# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6284 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6285# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6286 pcorr = 0._wp
6287# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6288
6289# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6290 if (low_mach == 1) then
6291# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6292 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))) &
6293# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6294 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6295# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6296 else if (low_mach == 2) then
6297# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6298 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))))
6299# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6300 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))))
6301# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6302 vel_l(dir_idx(1)) = vel_l_tmp
6303# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6304 vel_r(dir_idx(1)) = vel_r_tmp
6305# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6306 end if
6307# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6308 end if
6309 else
6310 pcorr = 0._wp
6311 end if
6312
6313 ! COMPUTING FLUXES MASS FLUX.
6314
6315# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6316#if defined(MFC_OpenACC)
6317# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6318!$acc loop seq
6319# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6320#elif defined(MFC_OpenMP)
6321# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6322
6323# 370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6324#endif
6325 do i = 1, eqn_idx%cont%end
6326 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6327 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6328 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6329 end do
6330
6331 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6332
6333# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6334#if defined(MFC_OpenACC)
6335# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6336!$acc loop seq
6337# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6338#elif defined(MFC_OpenMP)
6339# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6340
6341# 378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6342#endif
6343 do i = 1, num_dims
6344 flux_rsx_vf(j, k, l, &
6345 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
6346 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
6347 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
6348 & *dir_flg(dir_idx(i))*pcorr
6349 end do
6350
6351 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
6352 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
6353
6354 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
6355 if (elasticity) then
6356 flux_ene_e = 0._wp
6357
6358# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6359#if defined(MFC_OpenACC)
6360# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6361!$acc loop seq
6362# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6363#elif defined(MFC_OpenMP)
6364# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6365
6366# 393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6367#endif
6368 do i = 1, num_dims
6369 ! MOMENTUM ELASTIC FLUX.
6370 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
6371 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
6372 & - xi_p*tau_e_r(dir_idx_tau(i))
6373 ! ENERGY ELASTIC FLUX.
6374 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
6375 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
6376 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
6377 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
6378 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
6379 end do
6380 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
6381 end if
6382
6383 ! VOLUME FRACTION FLUX.
6384
6385# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6386#if defined(MFC_OpenACC)
6387# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6388!$acc loop seq
6389# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6390#elif defined(MFC_OpenMP)
6391# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6392
6393# 410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6394#endif
6395 do i = eqn_idx%adv%beg, eqn_idx%adv%end
6396 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6397 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
6398 end do
6399
6400 ! Advection velocity source: interface velocity for volume fraction transport
6401
6402# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6403#if defined(MFC_OpenACC)
6404# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6405!$acc loop seq
6406# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6407#elif defined(MFC_OpenMP)
6408# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6409
6410# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6411#endif
6412 do i = 1, num_dims
6413 vel_src_rsx_vf(j, k, l, &
6414 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
6415 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
6416 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
6417 end do
6418
6419 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
6420 ! energy flux
6421
6422# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6423#if defined(MFC_OpenACC)
6424# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6425!$acc loop seq
6426# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6427#elif defined(MFC_OpenMP)
6428# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6429
6430# 427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6431#endif
6432 do i = 1, num_fluids
6433 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
6434 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
6435 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
6436 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
6437 & + pres_r)
6438
6439 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
6440 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6441 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
6442 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
6443 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6444 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
6445 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
6446 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6447 & i + eqn_idx%adv%beg - 1))
6448 end do
6449
6450 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6451
6452 ! Hyperelastic reference map flux for material deformation tracking
6453 if (hyperelasticity) then
6454
6455# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6456#if defined(MFC_OpenACC)
6457# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6458!$acc loop seq
6459# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6460#elif defined(MFC_OpenMP)
6461# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6462
6463# 450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6464#endif
6465 do i = 1, num_dims
6466 flux_rsx_vf(j, k, l, &
6467 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
6468 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
6469 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
6470 end do
6471 end if
6472
6473 ! COLOR FUNCTION FLUX
6474 if (surface_tension) then
6475 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
6476 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
6477 end if
6478
6479 ! Geometrical source flux for cylindrical coordinates
6480# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6481# 489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6482 if (grid_geometry == 3) then
6483
6484# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6485#if defined(MFC_OpenACC)
6486# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6487!$acc loop seq
6488# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6489#elif defined(MFC_OpenMP)
6490# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6491
6492# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6493#endif
6494 do i = 1, sys_size
6495 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6496 end do
6497 flux_gsrc_rsx_vf(j, k, l, &
6498 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
6499 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
6500
6501 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
6502 end if
6503# 501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6504 end do
6505 end do
6506 end do
6507
6508# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6509#if defined(MFC_OpenACC)
6510# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6511!$acc end parallel loop
6512# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6513#elif defined(MFC_OpenMP)
6514# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6515
6516# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6517!$omp end target teams loop
6518# 504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6519#endif
6520 else if (model_eqns == model_eqns_4eq) then
6521 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
6522
6523# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6524
6525# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6526#if defined(MFC_OpenACC)
6527# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6528!$acc parallel loop collapse(3) gang vector default(present) &
6529# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6530!$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)
6531# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6532#elif defined(MFC_OpenMP)
6533# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6534
6535# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6536
6537# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6538
6539# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6540!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
6541# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6542!$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)
6543# 507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6544#endif
6545# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6546 do l = is1%beg, is1%end
6547 do k = is2%beg, is2%end
6548 do j = is3%beg, is3%end
6549 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6550 rho_l = 0._wp; rho_r = 0._wp
6551 gamma_l = 0._wp; gamma_r = 0._wp
6552 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6553 qv_l = 0._wp; qv_r = 0._wp
6554
6555
6556# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6557#if defined(MFC_OpenACC)
6558# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6559!$acc loop seq
6560# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6561#elif defined(MFC_OpenMP)
6562# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6563
6564# 525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6565#endif
6566 do i = 1, eqn_idx%cont%end
6567 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
6568 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
6569 end do
6570
6571
6572# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6573#if defined(MFC_OpenACC)
6574# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6575!$acc loop seq
6576# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6577#elif defined(MFC_OpenMP)
6578# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6579
6580# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6581#endif
6582 do i = 1, num_dims
6583 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6584 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
6585 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6586 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6587 end do
6588
6589
6590# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6591#if defined(MFC_OpenACC)
6592# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6593!$acc loop seq
6594# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6595#elif defined(MFC_OpenMP)
6596# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6597
6598# 539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6599#endif
6600 do i = 1, num_fluids
6601 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6602 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6603 end do
6604
6605# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6606#if defined(MFC_OpenACC)
6607# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6608!$acc loop seq
6609# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6610#elif defined(MFC_OpenMP)
6611# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6612
6613# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6614#endif
6615 do i = 1, num_fluids
6616 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6617 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6618 end do
6619
6620 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, pi_inf_l, &
6621 & qv_l)
6622 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, pi_inf_r, &
6623 & qv_r)
6624
6625 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6626 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
6627
6628 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6629 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6630
6631 h_l = (e_l + pres_l)/rho_l
6632 h_r = (e_r + pres_r)/rho_r
6633
6634 if (avg_state == avg_state_roe) then
6635# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6636 rho_avg = sqrt(rho_l*rho_r)
6637# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6638
6639# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6640 vel_avg_rms = 0._wp
6641# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6642
6643# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6644
6645# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6646#if defined(MFC_OpenACC)
6647# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6648!$acc loop seq
6649# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6650#elif defined(MFC_OpenMP)
6651# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6652
6653# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6654#endif
6655# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6656 do i = 1, num_vels
6657# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6658 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
6659# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6660 end do
6661# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6662
6663# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6664 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6665# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6666
6667# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6668 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6669# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6670
6671# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6672 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
6673# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6674
6675# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6676 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6677# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6678
6679# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6680 if (chemistry) then
6681# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6682 eps = 0.001_wp
6683# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6684 call get_species_enthalpies_rt(t_l, h_il)
6685# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6686 call get_species_enthalpies_rt(t_r, h_ir)
6687# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6688 h_il = h_il*gas_constant/molecular_weights*t_l
6689# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6690 h_ir = h_ir*gas_constant/molecular_weights*t_r
6691# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6692 call get_species_specific_heats_r(t_l, cp_il)
6693# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6694 call get_species_specific_heats_r(t_r, cp_ir)
6695# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6696
6697# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6698 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6699# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6700 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6701# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6702 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6703# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6704 if (abs(t_l - t_r) < eps) then
6705# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6706 ! Case when T_L and T_R are very close
6707# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6708 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6709# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6710 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6711# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6712 & - gas_constant/molecular_weights(:)))
6713# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6714 else
6715# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6716 ! Normal calculation when T_L and T_R are sufficiently different
6717# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6718 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6719# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6720 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6721# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6722 end if
6723# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6724 gamma_avg = cp_avg/cv_avg
6725# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6726
6727# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6728 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6729# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6730 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6731# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6732 end if
6733# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6734 end if
6735# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6736
6737# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6738 if (avg_state == avg_state_arithmetic) then
6739# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6740 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6741# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6742 vel_avg_rms = 0._wp
6743# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6744
6745# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6746#if defined(MFC_OpenACC)
6747# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6748!$acc loop seq
6749# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6750#elif defined(MFC_OpenMP)
6751# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6752
6753# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6754#endif
6755# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6756 do i = 1, num_vels
6757# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6758 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6759# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6760 end do
6761# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6762
6763# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6764 h_avg = 5.e-1_wp*(h_l + h_r)
6765# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6766 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6767# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6768 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6769# 564 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6770 end if
6771
6772 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6773 & c_l, qv_l)
6774
6775 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6776 & c_r, qv_r)
6777
6778 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6779 ! variables are placeholders to call the subroutine.
6780
6781 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6782 & 0._wp, c_avg, qv_avg)
6783
6784 if (wave_speeds == wave_speeds_direct) then
6785 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
6786 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
6787
6788 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
6789 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
6790 & - rho_r*(s_r - vel_r(dir_idx(1))))
6791 else if (wave_speeds == wave_speeds_pressure) then
6792 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
6793
6794 pres_sr = pres_sl
6795
6796 ! Low Mach correction: Thornber et al. JCP (2008)
6797 ms_l = max(1._wp, &
6798 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
6799 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
6800 ms_r = max(1._wp, &
6801 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
6802 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
6803
6804 s_l = vel_l(dir_idx(1)) - c_l*ms_l
6805 s_r = vel_r(dir_idx(1)) + c_r*ms_r
6806
6807 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
6808 end if
6809
6810 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
6811 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
6812
6813 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
6814 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6815 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6816 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
6817 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
6818
6819 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
6820 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
6821 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
6822
6823
6824# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6825#if defined(MFC_OpenACC)
6826# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6827!$acc loop seq
6828# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6829#elif defined(MFC_OpenMP)
6830# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6831
6832# 617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6833#endif
6834 do i = 1, eqn_idx%cont%end
6835 flux_rsx_vf(j, k, l, &
6836 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
6837 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6838 end do
6839
6840 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
6841
6842# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6843#if defined(MFC_OpenACC)
6844# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6845!$acc loop seq
6846# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6847#elif defined(MFC_OpenMP)
6848# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6849
6850# 625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6851#endif
6852 do i = 1, num_dims
6853 flux_rsx_vf(j, k, l, &
6854 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
6855 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
6856 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
6857 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
6858 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
6859 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
6860 end do
6861
6862 if (bubbles_euler) then
6863 ! Put p_tilde in
6864
6865# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6866#if defined(MFC_OpenACC)
6867# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6868!$acc loop seq
6869# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6870#elif defined(MFC_OpenMP)
6871# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6872
6873# 638 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6874#endif
6875 do i = 1, num_dims
6876 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
6877 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
6878 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
6879 end do
6880 end if
6881
6882 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
6883
6884
6885# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6886#if defined(MFC_OpenACC)
6887# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6888!$acc loop seq
6889# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6890#elif defined(MFC_OpenMP)
6891# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6892
6893# 648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6894#endif
6895 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
6896 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
6897 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
6898 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6899 end do
6900
6901 ! Advection velocity source: interface velocity for volume fraction transport
6902
6903# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6904#if defined(MFC_OpenACC)
6905# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6906!$acc loop seq
6907# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6908#elif defined(MFC_OpenMP)
6909# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6910
6911# 656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6912#endif
6913 do i = 1, num_dims
6914 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
6915 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
6916 end do
6917
6918 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
6919
6920 ! Add advection flux for bubble variables
6921 if (bubbles_euler) then
6922
6923# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6924#if defined(MFC_OpenACC)
6925# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6926!$acc loop seq
6927# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6928#elif defined(MFC_OpenMP)
6929# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6930
6931# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6932#endif
6933 do i = eqn_idx%bub%beg, eqn_idx%bub%end
6934 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
6935 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
6936 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, &
6937 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
6938 end do
6939 end if
6940
6941 ! Geometrical source flux for cylindrical coordinates
6942
6943# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6944# 698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6945 if (grid_geometry == 3) then
6946
6947# 699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6948#if defined(MFC_OpenACC)
6949# 699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6950!$acc loop seq
6951# 699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6952#elif defined(MFC_OpenMP)
6953# 699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6954
6955# 699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6956#endif
6957 do i = 1, sys_size
6958 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
6959 end do
6960 flux_gsrc_rsx_vf(j, k, l, &
6961 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
6962 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
6963 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
6964 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
6965 end if
6966# 710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6967 end do
6968 end do
6969 end do
6970
6971# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6972#if defined(MFC_OpenACC)
6973# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6974!$acc end parallel loop
6975# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6976#elif defined(MFC_OpenMP)
6977# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6978
6979# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6980!$omp end target teams loop
6981# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6982#endif
6983 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
6984 ! 5-equation model with Euler-Euler bubble dynamics
6985
6986# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6987
6988# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6989#if defined(MFC_OpenACC)
6990# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6991!$acc parallel loop collapse(3) gang vector default(present) &
6992# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6993!$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, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, 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) &
6994# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6995!$acc& firstprivate(Re_size_loc1, Re_size_loc2)
6996# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6997#elif defined(MFC_OpenMP)
6998# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
6999
7000# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7001
7002# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7003
7004# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7005!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
7006# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7007!$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, alpha_rho_L, alpha_rho_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, 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) &
7008# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7009!$omp& firstprivate(Re_size_loc1, Re_size_loc2)
7010# 716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7011#endif
7012# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7013 do l = is1%beg, is1%end
7014 do k = is2%beg, is2%end
7015 do j = is3%beg, is3%end
7016 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7017 rho_l = 0._wp; rho_r = 0._wp
7018 gamma_l = 0._wp; gamma_r = 0._wp
7019 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7020 qv_l = 0._wp; qv_r = 0._wp
7021
7022
7023# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7024#if defined(MFC_OpenACC)
7025# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7026!$acc loop seq
7027# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7028#elif defined(MFC_OpenMP)
7029# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7030
7031# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7032#endif
7033 do i = 1, num_fluids
7034 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7035 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7036 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7037 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7038 end do
7039
7040 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7041
7042
7043# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7044#if defined(MFC_OpenACC)
7045# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7046!$acc loop seq
7047# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7048#elif defined(MFC_OpenMP)
7049# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7050
7051# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7052#endif
7053 do i = 1, num_dims
7054 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7055 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7056 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7057 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7058 end do
7059
7060 ! Retain this in the refactor
7061 if (mpp_lim .and. (num_fluids > 2)) then
7062 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_l, rho_l, gamma_l, &
7063 & pi_inf_l, qv_l)
7064 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_r, rho_r, gamma_r, &
7065 & pi_inf_r, qv_r)
7066 else if (num_fluids > 2) then
7067 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_l, alpha_l, rho_l, gamma_l, &
7068 & pi_inf_l, qv_l)
7069 call s_accumulate_mixture_properties(num_fluids - 1, alpha_rho_r, alpha_r, rho_r, gamma_r, &
7070 & pi_inf_r, qv_r)
7071 else
7072 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7073 gamma_l = gammas(1)
7074 pi_inf_l = pi_infs(1)
7075 qv_l = qvs(1)
7076 rho_r = qr_prim_rsx_vf(j, k, l + 1, 1)
7077 gamma_r = gammas(1)
7078 pi_inf_r = pi_infs(1)
7079 qv_r = qvs(1)
7080 end if
7081
7082 if (viscous) then
7083 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7084
7085# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7086#if defined(MFC_OpenACC)
7087# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7088!$acc loop seq
7089# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7090#elif defined(MFC_OpenMP)
7091# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7092
7093# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7094#endif
7095 do i = 1, 2
7096 re_l(i) = dflt_real
7097 re_r(i) = dflt_real
7098
7099 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_l(i) = 0._wp
7100 if (merge(re_size_loc1, re_size_loc2, i == 1) > 0) re_r(i) = 0._wp
7101
7102
7103# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7104#if defined(MFC_OpenACC)
7105# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7106!$acc loop seq
7107# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7108#elif defined(MFC_OpenMP)
7109# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7110
7111# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7112#endif
7113 do q = 1, merge(re_size_loc1, re_size_loc2, i == 1)
7114 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7115 & q)))/res_gs(i, q) + re_l(i)
7116 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
7117 & q)))/res_gs(i, q) + re_r(i)
7118 end do
7119
7120 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7121 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7122 end do
7123 end if
7124 end if
7125
7126 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7127 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7128
7129 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7130 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7131
7132 h_l = (e_l + pres_l)/rho_l
7133 h_r = (e_r + pres_r)/rho_r
7134
7135 if (avg_state == avg_state_arithmetic) then
7136
7137# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7138#if defined(MFC_OpenACC)
7139# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7140!$acc loop seq
7141# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7142#elif defined(MFC_OpenMP)
7143# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7144
7145# 808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7146#endif
7147 do i = 1, nb
7148 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7149 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
7150
7151 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
7152 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
7153 if (.not. polytropic .and. .not. qbmm) then
7154 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
7155 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
7156 end if
7157 end do
7158
7159 if (.not. qbmm) then
7160 if (adv_n) then
7161 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
7162 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
7163 else
7164 nbub_l = 0._wp
7165 nbub_r = 0._wp
7166
7167# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7168#if defined(MFC_OpenACC)
7169# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7170!$acc loop seq
7171# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7172#elif defined(MFC_OpenMP)
7173# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7174
7175# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7176#endif
7177 do i = 1, nb
7178 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
7179 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
7180 end do
7181
7182 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
7183 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
7184 & eqn_idx%E + num_fluids)/nbub_r
7185 end if
7186 else
7187 ! nb stored in 0th moment of first R0 bin in variable conversion module
7188 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
7189 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
7190 end if
7191
7192
7193# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7194#if defined(MFC_OpenACC)
7195# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7196!$acc loop seq
7197# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7198#elif defined(MFC_OpenMP)
7199# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7200
7201# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7202#endif
7203 do i = 1, nb
7204 if (.not. qbmm) then
7205 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
7206 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
7207 end if
7208 end do
7209
7210 if (qbmm) then
7211 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
7212 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
7213
7214 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
7215 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
7216
7217 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
7218 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
7219 else
7220 pbwr3lbar = 0._wp
7221 pbwr3rbar = 0._wp
7222
7223 r3lbar = 0._wp
7224 r3rbar = 0._wp
7225
7226 r3v2lbar = 0._wp
7227 r3v2rbar = 0._wp
7228
7229
7230# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7231#if defined(MFC_OpenACC)
7232# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7233!$acc loop seq
7234# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7235#elif defined(MFC_OpenMP)
7236# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7237
7238# 871 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7239#endif
7240 do i = 1, nb
7241 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
7242 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
7243
7244 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
7245 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
7246
7247 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
7248 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
7249 end do
7250 end if
7251
7252 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7253 h_avg = 5.e-1_wp*(h_l + h_r)
7254 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7255 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7256 vel_avg_rms = 0._wp
7257
7258
7259# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7260#if defined(MFC_OpenACC)
7261# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7262!$acc loop seq
7263# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7264#elif defined(MFC_OpenMP)
7265# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7266
7267# 890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7268#endif
7269 do i = 1, num_dims
7270 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7271 end do
7272 end if
7273
7274 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7275 & c_l, qv_l)
7276
7277 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7278 & c_r, qv_r)
7279
7280 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7281 ! variables are placeholders to call the subroutine.
7282 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7283 & 0._wp, c_avg, qv_avg)
7284
7285 if (viscous) then
7286
7287# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7288#if defined(MFC_OpenACC)
7289# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7290!$acc loop seq
7291# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7292#elif defined(MFC_OpenMP)
7293# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7294
7295# 908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7296#endif
7297 do i = 1, 2
7298 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7299 end do
7300 end if
7301
7302 ! Low Mach correction
7303 if (low_mach == 2) then
7304 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7305# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7306 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7307# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7308 pcorr = 0._wp
7309# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7310
7311# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7312 if (low_mach == 1) then
7313# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7314 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7315# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7316 end if
7317# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7318 else if (riemann_solver == riemann_solver_hllc) then
7319# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7320 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7321# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7322 pcorr = 0._wp
7323# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7324
7325# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7326 if (low_mach == 1) then
7327# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7328 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))) &
7329# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7330 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7331# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7332 else if (low_mach == 2) then
7333# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7334 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))))
7335# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7336 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))))
7337# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7338 vel_l(dir_idx(1)) = vel_l_tmp
7339# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7340 vel_r(dir_idx(1)) = vel_r_tmp
7341# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7342 end if
7343# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7344 end if
7345 end if
7346
7347 if (wave_speeds == wave_speeds_direct) then
7348 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7349 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7350
7351 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7352 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7353 & - rho_r*(s_r - vel_r(dir_idx(1))))
7354 else if (wave_speeds == wave_speeds_pressure) then
7355 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7356
7357 pres_sr = pres_sl
7358
7359 ! Low Mach correction: Thornber et al. JCP (2008)
7360 ms_l = max(1._wp, &
7361 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7362 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7363 ms_r = max(1._wp, &
7364 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7365 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7366
7367 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7368 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7369
7370 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7371 end if
7372
7373 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7374 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7375
7376 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7377 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7378 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7379 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7380 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7381
7382 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7383 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7384 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7385
7386 ! Low Mach correction
7387 if (low_mach == 1) then
7388 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
7389# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7390 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7391# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7392 pcorr = 0._wp
7393# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7394
7395# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7396 if (low_mach == 1) then
7397# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7398 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7399# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7400 end if
7401# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7402 else if (riemann_solver == riemann_solver_hllc) then
7403# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7404 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7405# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7406 pcorr = 0._wp
7407# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7408
7409# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7410 if (low_mach == 1) then
7411# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7412 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))) &
7413# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7414 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7415# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7416 else if (low_mach == 2) then
7417# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7418 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))))
7419# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7420 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))))
7421# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7422 vel_l(dir_idx(1)) = vel_l_tmp
7423# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7424 vel_r(dir_idx(1)) = vel_r_tmp
7425# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7426 end if
7427# 960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7428 end if
7429 else
7430 pcorr = 0._wp
7431 end if
7432
7433
7434# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7435#if defined(MFC_OpenACC)
7436# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7437!$acc loop seq
7438# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7439#elif defined(MFC_OpenMP)
7440# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7441
7442# 965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7443#endif
7444 do i = 1, eqn_idx%cont%end
7445 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7446 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7447 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7448 end do
7449
7450 if (bubbles_euler .and. (num_fluids > 1)) then
7451 ! Kill mass transport @ gas density
7452 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
7453 end if
7454
7455 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7456
7457 ! Include p_tilde
7458
7459 if (avg_state == avg_state_arithmetic) then
7460 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
7461 pres_l = pres_l - alpha_l(num_fluids)*pres_l
7462 else
7463 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
7464 end if
7465
7466 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
7467 pres_r = pres_r - alpha_r(num_fluids)*pres_r
7468 else
7469 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
7470 end if
7471 end if
7472
7473
7474# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7475#if defined(MFC_OpenACC)
7476# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7477!$acc loop seq
7478# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7479#elif defined(MFC_OpenMP)
7480# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7481
7482# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7483#endif
7484 do i = 1, num_dims
7485 flux_rsx_vf(j, k, l, &
7486 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
7487 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7488 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
7489 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7490 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7491 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
7492 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7493 end do
7494
7495 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
7496 flux_rsx_vf(j, k, l, &
7497 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
7498 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
7499 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
7500 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
7501 & *pcorr*s_s
7502
7503 ! Volume fraction flux
7504
7505# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7506#if defined(MFC_OpenACC)
7507# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7508!$acc loop seq
7509# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7510#elif defined(MFC_OpenMP)
7511# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7512
7513# 1016 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7514#endif
7515 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7516 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7517 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
7518 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7519 end do
7520
7521 ! Advection velocity source: interface velocity for volume fraction transport
7522
7523# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7524#if defined(MFC_OpenACC)
7525# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7526!$acc loop seq
7527# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7528#elif defined(MFC_OpenMP)
7529# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7530
7531# 1024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7532#endif
7533 do i = 1, num_dims
7534 vel_src_rsx_vf(j, k, l, &
7535 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
7536 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
7537
7538 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7539 end do
7540
7541 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7542
7543 ! Add advection flux for bubble variables
7544
7545# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7546#if defined(MFC_OpenACC)
7547# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7548!$acc loop seq
7549# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7550#elif defined(MFC_OpenMP)
7551# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7552
7553# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7554#endif
7555 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7556 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7557 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7558 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7559 end do
7560
7561 if (qbmm) then
7562 flux_rsx_vf(j, k, l, &
7563 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7564 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7565 end if
7566
7567 if (adv_n) then
7568 flux_rsx_vf(j, k, l, &
7569 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7570 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7571 end if
7572
7573 ! Geometrical source flux for cylindrical coordinates
7574# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7575# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7576 if (grid_geometry == 3) then
7577
7578# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7579#if defined(MFC_OpenACC)
7580# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7581!$acc loop seq
7582# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7583#elif defined(MFC_OpenMP)
7584# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7585
7586# 1078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7587#endif
7588 do i = 1, sys_size
7589 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
7590 end do
7591
7592 flux_gsrc_rsx_vf(j, k, l, &
7593 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
7594 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
7595 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
7596 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
7597 end if
7598# 1090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7599 end do
7600 end do
7601 end do
7602
7603# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7604#if defined(MFC_OpenACC)
7605# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7606!$acc end parallel loop
7607# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7608#elif defined(MFC_OpenMP)
7609# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7610
7611# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7612!$omp end target teams loop
7613# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7614#endif
7615 else
7616 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
7617
7618# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7619
7620# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7621#if defined(MFC_OpenACC)
7622# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7623!$acc parallel loop collapse(3) gang vector default(present) &
7624# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7625!$acc& private(i, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, 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, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, 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) &
7626# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7627!$acc& firstprivate(Re_size_loc1, Re_size_loc2) copyin(is1, is2, is3)
7628# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7629#elif defined(MFC_OpenMP)
7630# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7631
7632# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7633
7634# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7635
7636# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7637!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
7638# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7639!$omp& private(i, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, 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, alpha_rho_L, alpha_rho_R, alpha_lim_L, alpha_lim_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, 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) &
7640# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7641!$omp& firstprivate(Re_size_loc1, Re_size_loc2) map(to:is1, is2, is3)
7642# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7643#endif
7644# 1105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7645 do l = is1%beg, is1%end
7646 do k = is2%beg, is2%end
7647 do j = is3%beg, is3%end
7648 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7649 rho_l = 0._wp; rho_r = 0._wp
7650 gamma_l = 0._wp; gamma_r = 0._wp
7651 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7652 qv_l = 0._wp; qv_r = 0._wp
7653 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
7654
7655
7656# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7657#if defined(MFC_OpenACC)
7658# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7659!$acc loop seq
7660# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7661#elif defined(MFC_OpenMP)
7662# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7663
7664# 1115 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7665#endif
7666 do i = 1, num_fluids
7667 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7668 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7669 end do
7670
7671
7672# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7673#if defined(MFC_OpenACC)
7674# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7675!$acc loop seq
7676# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7677#elif defined(MFC_OpenMP)
7678# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7679
7680# 1121 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7681#endif
7682 do i = 1, num_dims
7683 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7684 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
7685 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7686 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7687 end do
7688
7689 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7690 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
7691
7692 ! Change this by splitting it into the cases present in the bubbles_euler
7693 if (mpp_lim) then
7694
7695# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7696#if defined(MFC_OpenACC)
7697# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7698!$acc loop seq
7699# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7700#elif defined(MFC_OpenMP)
7701# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7702
7703# 1134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7704#endif
7705 do i = 1, num_fluids
7706 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
7707 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
7708 & eqn_idx%E + i)), 1._wp)
7709 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
7710 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
7711 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
7712 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7713 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7714 end do
7715
7716
7717# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7718#if defined(MFC_OpenACC)
7719# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7720!$acc loop seq
7721# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7722#elif defined(MFC_OpenMP)
7723# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7724
7725# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7726#endif
7727 do i = 1, num_fluids
7728 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
7729 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
7730 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
7731 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
7732 end do
7733 end if
7734
7735 ! Post-limiter loads for the mixture properties; alpha_L/R keep the pre-limiter loads used
7736 ! downstream
7737
7738# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7739#if defined(MFC_OpenACC)
7740# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7741!$acc loop seq
7742# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7743#elif defined(MFC_OpenMP)
7744# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7745
7746# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7747#endif
7748 do i = 1, num_fluids
7749 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7750 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
7751 alpha_lim_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7752 alpha_lim_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
7753 end do
7754
7755 call s_accumulate_mixture_properties(num_fluids, alpha_rho_l, alpha_lim_l, rho_l, gamma_l, &
7756 & pi_inf_l, qv_l)
7757 call s_accumulate_mixture_properties(num_fluids, alpha_rho_r, alpha_lim_r, rho_r, gamma_r, &
7758 & pi_inf_r, qv_r)
7759
7760 if (viscous) then
7761 call s_compute_interface_reynolds(alpha_l, re_l, re_size_loc1, re_size_loc2)
7762 call s_compute_interface_reynolds(alpha_r, re_r, re_size_loc1, re_size_loc2)
7763 end if
7764
7765 if (chemistry) then
7766 c_sum_yi_phi = 0.0_wp
7767
7768# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7769#if defined(MFC_OpenACC)
7770# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7771!$acc loop seq
7772# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7773#elif defined(MFC_OpenMP)
7774# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7775
7776# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7777#endif
7778 do i = eqn_idx%species%beg, eqn_idx%species%end
7779 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
7780 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
7781 end do
7782
7783 call get_mixture_molecular_weight(ys_l, mw_l)
7784 call get_mixture_molecular_weight(ys_r, mw_r)
7785
7786 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
7787 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
7788
7789 r_gas_l = gas_constant/mw_l
7790 r_gas_r = gas_constant/mw_r
7791
7792 t_l = pres_l/rho_l/r_gas_l
7793 t_r = pres_r/rho_r/r_gas_r
7794
7795 call get_species_specific_heats_r(t_l, cp_il)
7796 call get_species_specific_heats_r(t_r, cp_ir)
7797
7798 if (chem_params%gamma_method == 1) then
7799 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
7800 gamma_il = cp_il/(cp_il - 1.0_wp)
7801 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
7802
7803 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
7804 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
7805 else if (chem_params%gamma_method == 2) then
7806 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
7807 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
7808 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
7809 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
7810 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
7811
7812 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
7813 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
7814 end if
7815
7816 call get_mixture_energy_mass(t_l, ys_l, e_l)
7817 call get_mixture_energy_mass(t_r, ys_r, e_r)
7818
7819 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
7820 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
7821 h_l = (e_l + pres_l)/rho_l
7822 h_r = (e_r + pres_r)/rho_r
7823 else
7824 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
7825 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
7826
7827 h_l = (e_l + pres_l)/rho_l
7828 h_r = (e_r + pres_r)/rho_r
7829 end if
7830
7831 ! Hyperelastic stress contribution: strain energy added to total energy
7832 if (hyperelasticity) then
7833
7834# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7835#if defined(MFC_OpenACC)
7836# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7837!$acc loop seq
7838# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7839#elif defined(MFC_OpenMP)
7840# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7841
7842# 1233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7843#endif
7844 do i = 1, num_dims
7845 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
7846 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
7847 end do
7848 g_l = 0._wp
7849 g_r = 0._wp
7850
7851# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7852#if defined(MFC_OpenACC)
7853# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7854!$acc loop seq
7855# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7856#elif defined(MFC_OpenMP)
7857# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7858
7859# 1240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7860#endif
7861 do i = 1, num_fluids
7862 ! Mixture left and right shear modulus
7863 g_l = g_l + alpha_l(i)*gs_rs(i)
7864 g_r = g_r + alpha_r(i)*gs_rs(i)
7865 end do
7866 ! Elastic contribution to energy if G large enough
7867 if (g_l > verysmall .and. g_r > verysmall) then
7868 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
7869 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
7870 end if
7871
7872# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7873#if defined(MFC_OpenACC)
7874# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7875!$acc loop seq
7876# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7877#elif defined(MFC_OpenMP)
7878# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7879
7880# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7881#endif
7882 do i = 1, b_size - 1
7883 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
7884 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
7885 end do
7886 end if
7887
7888 h_l = (e_l + pres_l)/rho_l
7889 h_r = (e_r + pres_r)/rho_r
7890
7891 if (avg_state == avg_state_roe) then
7892# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7893 rho_avg = sqrt(rho_l*rho_r)
7894# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7895
7896# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7897 vel_avg_rms = 0._wp
7898# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7899
7900# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7901
7902# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7903#if defined(MFC_OpenACC)
7904# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7905!$acc loop seq
7906# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7907#elif defined(MFC_OpenMP)
7908# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7909
7910# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7911#endif
7912# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7913 do i = 1, num_vels
7914# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7915 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
7916# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7917 end do
7918# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7919
7920# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7921 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7922# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7923
7924# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7925 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7926# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7927
7928# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7929 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
7930# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7931
7932# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7933 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7934# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7935
7936# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7937 if (chemistry) then
7938# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7939 eps = 0.001_wp
7940# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7941 call get_species_enthalpies_rt(t_l, h_il)
7942# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7943 call get_species_enthalpies_rt(t_r, h_ir)
7944# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7945 h_il = h_il*gas_constant/molecular_weights*t_l
7946# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7947 h_ir = h_ir*gas_constant/molecular_weights*t_r
7948# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7949 call get_species_specific_heats_r(t_l, cp_il)
7950# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7951 call get_species_specific_heats_r(t_r, cp_ir)
7952# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7953
7954# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7955 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7956# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7957 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7958# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7959 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7960# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7961 if (abs(t_l - t_r) < eps) then
7962# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7963 ! Case when T_L and T_R are very close
7964# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7965 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7966# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7967 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7968# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7969 & - gas_constant/molecular_weights(:)))
7970# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7971 else
7972# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7973 ! Normal calculation when T_L and T_R are sufficiently different
7974# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7975 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7976# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7977 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7978# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7979 end if
7980# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7981 gamma_avg = cp_avg/cv_avg
7982# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7983
7984# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7985 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7986# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7987 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7988# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7989 end if
7990# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7991 end if
7992# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7993
7994# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7995 if (avg_state == avg_state_arithmetic) then
7996# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7997 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7998# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
7999 vel_avg_rms = 0._wp
8000# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8001
8002# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8003#if defined(MFC_OpenACC)
8004# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8005!$acc loop seq
8006# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8007#elif defined(MFC_OpenMP)
8008# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8009
8010# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8011#endif
8012# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8013 do i = 1, num_vels
8014# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8015 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8016# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8017 end do
8018# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8019
8020# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8021 h_avg = 5.e-1_wp*(h_l + h_r)
8022# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8023 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8024# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8025 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8026# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8027 end if
8028
8029 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8030 & c_l, qv_l)
8031
8032 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8033 & c_r, qv_r)
8034
8035 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8036 ! variables are placeholders to call the subroutine.
8037 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8038 & c_sum_yi_phi, c_avg, qv_avg)
8039
8040 if (viscous) then
8041 if (chemistry) then
8042 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8043 end if
8044
8045# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8046#if defined(MFC_OpenACC)
8047# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8048!$acc loop seq
8049# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8050#elif defined(MFC_OpenMP)
8051# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8052
8053# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8054#endif
8055 do i = 1, 2
8056 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8057 end do
8058 end if
8059
8060 ! Low Mach correction
8061 if (low_mach == 2) then
8062 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8063# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8064 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8065# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8066 pcorr = 0._wp
8067# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8068
8069# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8070 if (low_mach == 1) then
8071# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8072 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8073# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8074 end if
8075# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8076 else if (riemann_solver == riemann_solver_hllc) then
8077# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8078 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8079# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8080 pcorr = 0._wp
8081# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8082
8083# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8084 if (low_mach == 1) then
8085# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8086 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))) &
8087# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8088 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8089# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8090 else if (low_mach == 2) then
8091# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8092 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))))
8093# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8094 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))))
8095# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8096 vel_l(dir_idx(1)) = vel_l_tmp
8097# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8098 vel_r(dir_idx(1)) = vel_r_tmp
8099# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8100 end if
8101# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8102 end if
8103 end if
8104
8105 if (wave_speeds == wave_speeds_direct) then
8106 if (elasticity) then
8107 ! Elastic wave speed, Rodriguez et al. JCP (2019)
8108 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) &
8109 & ))/rho_l), &
8110 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
8111 & + tau_e_r(dir_idx_tau(1)))/rho_r))
8112 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) &
8113 & ))/rho_r), &
8114 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
8115 & + tau_e_l(dir_idx_tau(1)))/rho_l))
8116 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
8117 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
8118 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
8119 & - vel_r(dir_idx(1))))
8120 else
8121 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8122 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8123 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8124 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
8125 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
8126 end if
8127 else if (wave_speeds == wave_speeds_pressure) then
8128 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8129
8130 pres_sr = pres_sl
8131
8132 ! Low Mach correction: Thornber et al. JCP (2008)
8133 ms_l = max(1._wp, &
8134 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8135 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8136 ms_r = max(1._wp, &
8137 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8138 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8139
8140 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8141 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8142
8143 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8144 end if
8145
8146 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8147 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8148
8149 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8150 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8151 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8152 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
8153 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8154 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8155
8156 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8157 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8158 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8159
8160 ! Low Mach correction
8161 if (low_mach == 1) then
8162 if (riemann_solver == riemann_solver_hll .or. riemann_solver == riemann_solver_lax_friedrichs) then
8163# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8164 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8165# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8166 pcorr = 0._wp
8167# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8168
8169# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8170 if (low_mach == 1) then
8171# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8172 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8173# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8174 end if
8175# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8176 else if (riemann_solver == riemann_solver_hllc) then
8177# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8178 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8179# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8180 pcorr = 0._wp
8181# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8182
8183# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8184 if (low_mach == 1) then
8185# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8186 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))) &
8187# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8188 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8189# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8190 else if (low_mach == 2) then
8191# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8192 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))))
8193# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8194 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))))
8195# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8196 vel_l(dir_idx(1)) = vel_l_tmp
8197# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8198 vel_r(dir_idx(1)) = vel_r_tmp
8199# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8200 end if
8201# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8202 end if
8203 else
8204 pcorr = 0._wp
8205 end if
8206
8207 ! COMPUTING THE HLLC FLUXES MASS FLUX.
8208
8209# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8210#if defined(MFC_OpenACC)
8211# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8212!$acc loop seq
8213# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8214#elif defined(MFC_OpenMP)
8215# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8216
8217# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8218#endif
8219 do i = 1, eqn_idx%cont%end
8220 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8221 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8222 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8223 end do
8224
8225 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
8226 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
8227
8228# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8229#if defined(MFC_OpenACC)
8230# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8231!$acc loop seq
8232# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8233#elif defined(MFC_OpenMP)
8234# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8235
8236# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8237#endif
8238 do i = 1, num_dims
8239 flux_rsx_vf(j, k, l, &
8240 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
8241 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
8242 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
8243 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
8244 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
8245 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8246 end do
8247
8248 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
8249 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
8250 flux_rsx_vf(j, k, l, &
8251 & 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 &
8252 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
8253 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
8254 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
8255 & *(s_p/s_r)*pcorr*s_s
8256
8257 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
8258 if (elasticity) then
8259 flux_ene_e = 0._wp
8260
8261# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8262#if defined(MFC_OpenACC)
8263# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8264!$acc loop seq
8265# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8266#elif defined(MFC_OpenMP)
8267# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8268
8269# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8270#endif
8271 do i = 1, num_dims
8272 ! MOMENTUM ELASTIC FLUX.
8273 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
8274 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
8275 & - xi_p*tau_e_r(dir_idx_tau(i))
8276 ! ENERGY ELASTIC FLUX.
8277 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
8278 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
8279 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
8280 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
8281 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
8282 end do
8283 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
8284 end if
8285
8286 ! VOLUME FRACTION FLUX.
8287
8288# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8289#if defined(MFC_OpenACC)
8290# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8291!$acc loop seq
8292# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8293#elif defined(MFC_OpenMP)
8294# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8295
8296# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8297#endif
8298 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8299 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8300 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
8301 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8302 end do
8303
8304 ! VOLUME FRACTION SOURCE FLUX.
8305
8306# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8307#if defined(MFC_OpenACC)
8308# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8309!$acc loop seq
8310# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8311#elif defined(MFC_OpenMP)
8312# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8313
8314# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8315#endif
8316 do i = 1, num_dims
8317 vel_src_rsx_vf(j, k, l, &
8318 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8319 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8320 end do
8321
8322 ! COLOR FUNCTION FLUX
8323 if (surface_tension) then
8324 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
8325 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8326 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8327 end if
8328
8329 ! Hyperelastic reference map flux for material deformation tracking
8330 if (hyperelasticity) then
8331
8332# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8333#if defined(MFC_OpenACC)
8334# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8335!$acc loop seq
8336# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8337#elif defined(MFC_OpenMP)
8338# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8339
8340# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8341#endif
8342 do i = 1, num_dims
8343 flux_rsx_vf(j, k, l, &
8344 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
8345 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
8346 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
8347 end do
8348 end if
8349
8350 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8351
8352 if (chemistry) then
8353
8354# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8355#if defined(MFC_OpenACC)
8356# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8357!$acc loop seq
8358# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8359#elif defined(MFC_OpenMP)
8360# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8361
8362# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8363#endif
8364 do i = eqn_idx%species%beg, eqn_idx%species%end
8365 y_l = ql_prim_rsx_vf(j, k, l, i)
8366 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
8367
8368 flux_rsx_vf(j, k, l, &
8369 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8370 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8371 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
8372 end do
8373 end if
8374
8375 ! Geometrical source flux for cylindrical coordinates
8376# 1470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8377# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8378 if (grid_geometry == 3) then
8379
8380# 1472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8381#if defined(MFC_OpenACC)
8382# 1472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8383!$acc loop seq
8384# 1472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8385#elif defined(MFC_OpenMP)
8386# 1472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8387
8388# 1472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8389#endif
8390 do i = 1, sys_size
8391 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
8392 end do
8393
8394 flux_gsrc_rsx_vf(j, k, l, &
8395 & eqn_idx%mom%beg + 1) = -f_compute_hllc_star_momentum_flux(rho_l, &
8396 & rho_r, vel_l(dir_idx(1)), vel_r(dir_idx(1)), s_m, s_p, s_s, xi_l, &
8397 & xi_r, xi_m, xi_p, dir_flg(dir_idx(1)))
8398 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
8399 end if
8400# 1484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8401 end do
8402 end do
8403 end do
8404
8405# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8406#if defined(MFC_OpenACC)
8407# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8408!$acc end parallel loop
8409# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8410#elif defined(MFC_OpenMP)
8411# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8412
8413# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8414!$omp end target teams loop
8415# 1487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8416#endif
8417 end if
8418 end if
8419# 1491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hllc.fpp"
8420 ! Computing HLLC flux and source flux for Euler system of equations
8421
8422 if (viscous) then
8423 if (weno_re_flux) then
8424 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8425 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8426 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8427 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8428 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8429 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8430 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8431 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
8432 & norm_dir, ix, iy, iz)
8433 else
8434 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8435 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8436 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8437 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8438 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8439 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8440 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
8441 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, q_prim_vf, &
8442 & norm_dir, ix, iy, iz)
8443 end if
8444 end if
8445
8446 if (surface_tension) then
8447 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
8448 end if
8449
8450 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
8451
8452 end subroutine s_hllc_riemann_solver
8453
8454end module m_riemann_solver_hllc
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:323
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:360
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:360
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:360
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged model.
Definition m_bubbles.fpp.f90:323
m_bubbles::f_cpbw_km
real(wp) function f_cpbw_km(fr0, fr, fv, fpb)
Keller-Miksis bubble wall pressure.
Definition m_bubbles.fpp.f90:608
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:335
m_chemistry::compute_viscosity_and_inversion
subroutine compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l, re_r)
Compute mixture viscosities for left and right states and invert them for use as reciprocal Reynolds ...
Definition m_chemistry.fpp.f90:376
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_4eq
integer, parameter model_eqns_4eq
Definition m_constants.fpp.f90:141
m_constants::model_eqns_5eq
integer, parameter model_eqns_5eq
Definition m_constants.fpp.f90:139
m_constants::avg_state_roe
integer, parameter avg_state_roe
Definition m_constants.fpp.f90:127
m_constants::wave_speeds_direct
integer, parameter wave_speeds_direct
Definition m_constants.fpp.f90:161
m_constants::riemann_solver_hll
integer, parameter riemann_solver_hll
Definition m_constants.fpp.f90:154
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:155
m_constants::wave_speeds_pressure
integer, parameter wave_speeds_pressure
Definition m_constants.fpp.f90:162
m_constants::riemann_solver_lax_friedrichs
integer, parameter riemann_solver_lax_friedrichs
Definition m_constants.fpp.f90:157
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:16
m_constants::small_alf
real(wp), parameter small_alf
Small alf tolerance.
Definition m_constants.fpp.f90:15
m_constants::verysmall
real(wp), parameter verysmall
Very small number.
Definition m_constants.fpp.f90:17
m_constants::avg_state_arithmetic
integer, parameter avg_state_arithmetic
Definition m_constants.fpp.f90:128
m_constants::model_eqns_6eq
integer, parameter model_eqns_6eq
Definition m_constants.fpp.f90:140
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:334
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:691
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:693
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:860
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:750
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:752
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:861
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1006
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1006
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:751
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:844
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1006
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::f_compute_hllc_star_momentum_flux
real(wp) function f_compute_hllc_star_momentum_flux(rho_l, rho_r, vel_l_norm, vel_r_norm, s_m, s_p, s_s, xi_l, xi_r, xi_m, xi_p, dir_flg_norm)
Compute the advective part of the HLLC star-state momentum flux in the wave-normal direction (pressur...
Definition m_riemann_state.fpp.f90:2793
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:2845
m_riemann_state::s_compute_interface_reynolds
subroutine s_compute_interface_reynolds(alpha_k, re_k, re_size_loc1, re_size_loc2)
Compute the shear and volume Reynolds numbers of one Riemann state by inverse-weighting the fluid Rey...
Definition m_riemann_state.fpp.f90:2606
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::s_accumulate_mixture_properties
subroutine s_accumulate_mixture_properties(nf, alpha_rho_k, alpha_k, rho_k, gamma_k, pi_inf_k, qv_k)
Accumulate the mixture density, specific heat ratio function, liquid stiffness function,...
Definition m_riemann_state.fpp.f90:2536
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