MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_riemann_solver_hypo_hlld.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2!>
3!! @file
4!! @brief Contains module m_riemann_solver_hypo_hlld
5
6!> @brief Dual-pass HLLD approximate Riemann solver for hypoelastic flows, with non-conservative interface-velocity coupling
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_hypo_hlld.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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
33! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
34! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
35# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
36# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
37# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
38
39# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57! New line at end of file is required for FYPP
58# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
59# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
60# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
61# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
73! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
74! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
75# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
76# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
77# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
78
79# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85
86# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87
88# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
89
90# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
91
92# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
93
94# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
95
96# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
97! New line at end of file is required for FYPP
98# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
99
100# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164
165# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
166
167# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
168
169# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
170
171# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
172
173# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
174
175# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
176! New line at end of file is required for FYPP
177# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
178# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
179# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
180# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
182# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
184# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
185
186# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
189
190# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
191# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
192! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
193! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
194# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
195# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
196# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
197
198# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
199# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204
205# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
206
207# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
208
209# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
210
211# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
212
213# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
214
215# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
216! New line at end of file is required for FYPP
217# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
218
219# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262
263# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
264
265# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
266
267# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
268
269# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
270
271# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
272
273# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
274! New line at end of file is required for FYPP
275# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
276
277! GPU parallel region (scalar reductions, maxval/minval)
278# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! GPU parallel loop over threads (most common GPU macro)
281# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Required closing for GPU_PARALLEL_LOOP
284# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Mark routine for device compilation
287# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Declare device-resident data
290# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Inner loop within a GPU parallel region
293# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Scoped GPU data region
296# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! Host code with device pointers (for MPI with GPU buffers)
299# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Allocate device memory (unscoped)
302# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Free device memory
305# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Atomic operation on device
308# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! End atomic capture block
311# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Copy data between host and device
314# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Synchronization barrier
317# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Import GPU library module (openacc or omp_lib)
320# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322! Emit code only for AMD compiler
323# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324
325! Emit code for non-Cray compilers
326# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
327
328! Emit code only for Cray compiler
329# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
330
331! Emit code for non-NVIDIA compilers
332# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
333
334# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
335# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
336! New line at end of file is required for FYPP
337# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
338
339# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
340
341! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
342! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
343! example see misc/nvidia_uvm/bind.sh.
344# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Allocate and create GPU device memory
347# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349! Free GPU device memory and deallocate
350# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
351
352! Cray-specific GPU pointer setup for vector fields
353# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
354
355! Cray-specific GPU pointer setup for scalar fields
356# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
357
358! Cray-specific GPU pointer setup for acoustic source spatials
359# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
360
361# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
362
363# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
364! New line at end of file is required for FYPP
365# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp" 2
366
367module m_riemann_solver_hypo_hlld
368
369 use m_derived_types
370 use m_global_parameters
371 use m_variables_conversion
372 use m_eos
373 use m_riemann_state
374
375 implicit none
376
377 !> Four-epsilon roundoff band for G_eff: two mixture products, their sum, and the final signed sum. Relative to the operand
378 !! scale; not a physical stiffness cutoff.
379 real(wp), parameter :: g_eff_roundoff_factor = 4._wp
380
381contains
382
383 !> Classify the position of the interface (xi = 0) in the five-wave HLLD fan: 0 left of S_L, 1..4 for the four inner wedges, 5
384 !! right of S_R. Single definition of the wave-fan geometry shared by the flux fold, the NC face-velocity export, and the
385 !! axisymmetric face-state pick, which must stay consistent. Valid fans only: a fallback face exports the HLL/one-sided traces
386 !! instead of a fan classification.
387 integer function f_hlld_wave_zone(S_L, S_Lstar, s_M, S_Rstar, S_R) result(zone)
388
389
390# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
391#ifdef _CRAYFTN
392# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
393#if MFC_OpenACC
394# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
395!$acc routine seq
396# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
397#elif MFC_OpenMP
398# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
399
400# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
401
402# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
403!$omp declare target device_type(any)
404# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
405#else
406# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
407!DIR$ INLINEALWAYS f_hlld_wave_zone
408# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
409#endif
410# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
411#elif MFC_OpenACC
412# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
413!$acc routine seq
414# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
415#elif MFC_OpenMP
416# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
417
418# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
419
420# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
421!$omp declare target device_type(any)
422# 31 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
423#endif
424# 32 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
425 real(wp), intent(in) :: s_l, s_lstar, s_m, s_rstar, s_r
426
427 if (0._wp <= s_l) then
428 zone = 0
429 else if (0._wp <= s_lstar) then
430 zone = 1
431 else if (0._wp <= s_m) then
432 zone = 2
433 else if (0._wp <= s_rstar) then
434 zone = 3
435 else if (0._wp <= s_r) then
436 zone = 4
437 else
438 zone = 5
439 end if
440
441 end function f_hlld_wave_zone
442
443 !> Per-component HLL flux on the compact (U_L, U_R, F_L, F_R) basis. Shared by the degenerate-fan fallback and the ADC blend,
444 !! which must stay consistent.
445 function f_hll_flux(S_L, S_R, F_L_i, F_R_i, U_L_i, U_R_i) result(flux)
446
447
448# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
449#ifdef _CRAYFTN
450# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
451#if MFC_OpenACC
452# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
453!$acc routine seq
454# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
455#elif MFC_OpenMP
456# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
457
458# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
459
460# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
461!$omp declare target device_type(any)
462# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
463#else
464# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
465!DIR$ INLINEALWAYS f_hll_flux
466# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
467#endif
468# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
469#elif MFC_OpenACC
470# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
471!$acc routine seq
472# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
473#elif MFC_OpenMP
474# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
475
476# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
477
478# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
479!$omp declare target device_type(any)
480# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
481#endif
482# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
483
484 real(wp), intent(in) :: s_l, s_r, f_l_i, f_r_i, u_l_i, u_r_i
485 real(wp) :: flux
486
487 flux = (s_r*f_l_i - s_l*f_r_i + s_l*s_r*(u_r_i - u_l_i))/(s_r - s_l + verysmall)
488
489 end function f_hll_flux
490
491 !> HLLD Riemann solver resolves all 5 waves for the hypoelastic equations: 1 entropy wave, 2 shear stress waves, 2 fast waves.
492 subroutine s_hypo_hlld_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, qL_prim_vf, &
493 & qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, &
494 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
495
496 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
497 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
498 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
499
500 type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf
501 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
502 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
503 integer, intent(in) :: norm_dir
504 type(int_bounds_info), intent(in) :: ix, iy, iz
505
506 ! Local variables:
507
508 ! Hypo HLLD has num_fluids==2 guard -> reads alpha_* at a hard-coded index 2.
509 ! With case-opt, `num_fluids=1` makes dimension(num_fluids) length 1,
510 ! so amdflang gives a compile-time out-of-bounds error. max(num_fluids, 2) fixes it
511
512# 89 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
513 real(wp), dimension(num_fluids) :: alpha_L, alpha_R, alpha_rho_L, alpha_rho_R
514# 91 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
515 type(riemann_states_vec3) :: vel
516 type(riemann_states) :: rho, pres, E
517 type(riemann_states) :: gamma, pi_inf, qv
518 type(riemann_states) :: vel_rms
519 type(riemann_states) :: c
520
521 ! HLLD speeds and intermediate state variables:
522 real(wp) :: S_L, S_R, s_M, S_Lstar, S_Rstar
523 real(wp) :: pTot_L, pTot_R, rhoL_star, rhoR_star
524 real(wp), dimension(14) :: U_L, U_R
525 real(wp), dimension(14) :: F_L, F_R, F_hlld
526 real(wp) :: us_c, uss_c ! selected-side U_star / U_starstar, one component at a time (register diet)
527 real(wp) :: F_HLL_c ! per-component HLL flux for ADC blending (diet: replaces the F_HLL array)
528 real(wp) :: U_HLL_c ! per-component HLL state for the ADC axisym trace (diet: replaces the U_HLL array)
529 real(wp) :: rho_HLL, u_n_HLL_cons, tau_nn_HLL
530 real(wp) :: u_n_HLL_trace, u_t_HLL_trace
531 real(wp) :: p_face_HLL, tau_qq_face_HLL
532 integer :: ncomp ! 11 for 2D/axisym, 14 for 3D Cartesian
533
534 ! HLLD Hypo variables
535
536 real(wp) :: G_eff, G_eff_tol, C_NC, sqrtC_NC
537 real(wp) :: A_L, A_R, denomA, fac_L, fac_R
538 real(wp) :: u_n_L, u_t_L, u_n_R, u_t_R
539 real(wp) :: u_t2_L, u_t2_R
540 real(wp) :: tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R
541 real(wp) :: tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R
542 real(wp) :: tau_qq_L, tau_qq_R
543 real(wp) :: G_L, G_R
544# 123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
545 real(wp), dimension(eqn_idx%stress%end - eqn_idx%stress%beg + 1) :: tau_e_L, tau_e_R
546# 125 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
547
548 real(wp) :: alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star
549 real(wp) :: u_t_star, tau_nt_star
550 real(wp) :: u_t2_star, tau_nt2_star
551 real(wp) :: tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star
552 real(wp) :: tau_tt_L_starstar, tau_tt_R_starstar
553 real(wp) :: tau_t2t2_L_star, tau_t2t2_R_star
554 real(wp) :: tau_t2t2_L_starstar, tau_t2t2_R_starstar
555 real(wp) :: tau_t1t2_L_star, tau_t1t2_R_star
556 real(wp) :: tau_t1t2_L_starstar, tau_t1t2_R_starstar
557 real(wp) :: tau_qq_L_star, tau_qq_R_star
558 real(wp) :: pTot_star
559 real(wp) :: E_L_star, E_R_star
560 real(wp) :: E_L_starstar, E_R_starstar
561 real(wp) :: p_face, tau_qq_face
562 real(wp) :: u_n_face, u_t_face
563 real(wp) :: G_hat
564 real(wp) :: rho_hat
565 real(wp) :: tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat
566 real(wp) :: tau_nt2_hat, tau_t2t2_hat, tau_t1t2_hat
567 ! alpha_hat/alpha_rho_hat: same max(num_fluids, 2) reason as alpha_* above
568# 153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
569 real(wp), dimension(num_fluids) :: alpha_hat, alpha_rho_hat
570 real(wp), dimension(eqn_idx%stress%end - eqn_idx%stress%beg + 1) :: tau_e_hat
571# 156 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
572
573 real(wp) :: pres_hat, blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q
574 real(wp) :: C_hat_1, C_hat_2
575 real(wp) :: Sigma_L, Sigma_R, dSigma, Sigma_ref
576 real(wp) :: a_L_ref, a_R_ref, a_ref
577 real(wp) :: du_t, dtau_nt, du_t2, dtau_nt2
578 real(wp) :: sensor_ptot, sensor_vt, sensor_tnt, sensor_combined
579 real(wp) :: phi
580 real(wp), parameter :: ADC_power = 1.0_wp
581 real(wp) :: alpha_L_sum, alpha_R_sum
582 logical :: degenerate, shear_degenerate, fan_fallback, shear_cond
583 integer :: i, j, k, l, ipass, zone
584
585 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
586 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
587
588 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
589
590# 178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
591# 179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
592# 180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
593 if (norm_dir == 1) then
594# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
595 ! Anchor-cell index pattern: the fused kernel reads both anchors (hat_L: face cell, hat_R: face cell + 1)
596 ! directly from q_prim_vf; loop indices are physical, so the offset rides the stencil index.
597# 184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
598 ! The fused HLLD kernel privatizes ~150 scalars -- a private() list large enough that
599 ! the single clause must be wrapped across continuation lines. The four fragments
600 ! (_hlld_p1..p4) are ONLY for source readability; fypp concatenates them into one
601 ! clause below. That wrapping is FOLD_DIRECTIVE's job -- its within-clause comma split
602 ! exists for exactly this case -- not the fragments'.
603# 190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
604# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
605# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
606# 193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
607 ! Wave-fan side table for the per-component F_hlld fold below: side name, the side's two zones,
608 ! its starstar zone, and the outer/inner wave speeds. The L and R sides are mirror images.
609# 196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
610 ! Wave-fan component tables for the per-component fold below: (us, uss) expression pairs in
611 ! F_hlld component order; uss = None means the inner (starstar) correction leaves the
612 ! component unchanged (uss_c = us_c). '{S}' expands to the fan side (L/R).
613# 213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
614# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
615
616# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
617
618# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
619#if defined(MFC_OpenACC)
620# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
621!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, ipass, degenerate, shear_degenerate, fan_fallback, shear_cond, alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, &
622# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
623!$acc& pres, E, gamma, pi_inf, qv, vel_rms, c, S_L, S_R, s_M, S_Lstar, S_Rstar, pTot_L, pTot_R, rhoL_star, rhoR_star, U_L, U_R, F_L, F_R, F_hlld, us_c, uss_c, zone, F_HLL_c, U_HLL_c, rho_HLL, &
624# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
625!$acc& u_n_HLL_cons, tau_nn_HLL, u_n_HLL_trace, u_t_HLL_trace, p_face_HLL, tau_qq_face_HLL, ncomp, G_eff, G_eff_tol, C_NC, sqrtC_NC, A_L, A_R, denomA, fac_L, fac_R, u_n_L, u_t_L, u_n_R, u_t_R, u_t2_L, &
626# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
627!$acc& u_t2_R, tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R, tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, G_L, G_R, tau_e_L, tau_e_R, &
628# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
629!$acc& alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star, u_t_star, tau_nt_star, u_t2_star, tau_nt2_star, tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star, tau_tt_L_starstar, &
630# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
631!$acc& tau_tt_R_starstar, tau_t2t2_L_star, tau_t2t2_R_star, tau_t2t2_L_starstar, tau_t2t2_R_starstar, tau_t1t2_L_star, tau_t1t2_R_star, tau_t1t2_L_starstar, tau_t1t2_R_starstar, tau_qq_L_star, &
632# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
633!$acc& tau_qq_R_star, pTot_star, E_L_star, E_R_star, E_L_starstar, E_R_starstar, p_face, tau_qq_face, u_n_face, u_t_face, G_hat, rho_hat, tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat, tau_nt2_hat, &
634# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
635!$acc& tau_t2t2_hat, tau_t1t2_hat, alpha_hat, alpha_rho_hat, tau_e_hat, pres_hat, blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q, C_hat_1, C_hat_2, Sigma_L, Sigma_R, dSigma, Sigma_ref, &
636# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
637!$acc& a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, phi, alpha_L_sum, alpha_R_sum)
638# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
639#elif defined(MFC_OpenMP)
640# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
641
642# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
643
644# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
645
646# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
647!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, &
648# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
649!$omp& ipass, degenerate, shear_degenerate, fan_fallback, shear_cond, alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, gamma, pi_inf, qv, vel_rms, c, S_L, S_R, s_M, S_Lstar, S_Rstar, &
650# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
651!$omp& pTot_L, pTot_R, rhoL_star, rhoR_star, U_L, U_R, F_L, F_R, F_hlld, us_c, uss_c, zone, F_HLL_c, U_HLL_c, rho_HLL, u_n_HLL_cons, tau_nn_HLL, u_n_HLL_trace, u_t_HLL_trace, p_face_HLL, &
652# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
653!$omp& tau_qq_face_HLL, ncomp, G_eff, G_eff_tol, C_NC, sqrtC_NC, A_L, A_R, denomA, fac_L, fac_R, u_n_L, u_t_L, u_n_R, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R, &
654# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
655!$omp& tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, G_L, G_R, tau_e_L, tau_e_R, alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star, u_t_star, &
656# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
657!$omp& tau_nt_star, u_t2_star, tau_nt2_star, tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star, tau_tt_L_starstar, tau_tt_R_starstar, tau_t2t2_L_star, tau_t2t2_R_star, tau_t2t2_L_starstar, &
658# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
659!$omp& tau_t2t2_R_starstar, tau_t1t2_L_star, tau_t1t2_R_star, tau_t1t2_L_starstar, tau_t1t2_R_starstar, tau_qq_L_star, tau_qq_R_star, pTot_star, E_L_star, E_R_star, E_L_starstar, E_R_starstar, p_face, &
660# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
661!$omp& tau_qq_face, u_n_face, u_t_face, G_hat, rho_hat, tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat, tau_nt2_hat, tau_t2t2_hat, tau_t1t2_hat, alpha_hat, alpha_rho_hat, tau_e_hat, pres_hat, &
662# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
663!$omp& blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q, C_hat_1, C_hat_2, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, &
664# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
665!$omp& sensor_vt, sensor_tnt, sensor_combined, phi, alpha_L_sum, alpha_R_sum)
666# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
667#endif
668# 225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
669 do l = is3%beg, is3%end
670# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
671 do k = is2%beg, is2%end
672# 227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
673 do j = is1%beg, is1%end
674# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
675 ! Extract left/right primitive states
676
677 do i = 1, eqn_idx%cont%end
678 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
679# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
680 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
681# 233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
682 end do
683
684 ! Initialize the unused third velocity component in 2D
685 vel%L = 0._wp
686 vel%R = 0._wp
687
688 ! Load velocities in physical-coordinate order; map directional aliases below via dir_idx
689 do i = 1, num_vels
690 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
691# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
692 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
693# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
694 end do
695
696 vel_rms%L = vel%L(1)**2 + vel%L(2)**2 + vel%L(3)**2
697 vel_rms%R = vel%R(1)**2 + vel%R(2)**2 + vel%R(3)**2
698
699 do i = 1, num_fluids
700 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
701# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
702 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
703# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
704 end do
705
706 ! Clamp and renormalize volume fractions when mpp_lim is on (match HLL/HLLC)
707 alpha_l_sum = 0._wp
708 alpha_r_sum = 0._wp
709 if (mpp_lim) then
710 do i = 1, num_fluids
711 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
712 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
713 alpha_l_sum = alpha_l_sum + alpha_l(i)
714 end do
715 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
716
717 do i = 1, num_fluids
718 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
719 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
720 alpha_r_sum = alpha_r_sum + alpha_r(i)
721 end do
722 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
723 end if
724
725 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
726# 273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
727 pres%R = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
728# 274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
729
730 ! Hypoelasticity
731
732# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
733#if defined(MFC_OpenACC)
734# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
735!$acc loop seq
736# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
737#elif defined(MFC_OpenMP)
738# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
739
740# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
741#endif
742# 277 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
743 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
744 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
745# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
746 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
747# 280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
748 end do
749
750 u_t2_l = 0._wp; u_t2_r = 0._wp
751 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
752 tau_t2t2_l = 0._wp; tau_t2t2_r = 0._wp
753 tau_t1t2_l = 0._wp; tau_t1t2_r = 0._wp
754
755 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
756 u_n_l = vel%L(dir_idx(1)); u_n_r = vel%R(dir_idx(1))
757 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
758 if (n == 0) then
759 ncomp = 11
760 else if (p == 0) then
761 ncomp = 11
762 u_t_l = vel%L(dir_idx(2)); u_t_r = vel%R(dir_idx(2))
763 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
764 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
765 else
766 ncomp = 14
767 u_t_l = vel%L(dir_idx(2)); u_t_r = vel%R(dir_idx(2))
768 u_t2_l = vel%L(dir_idx(3)); u_t2_r = vel%R(dir_idx(3))
769 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
770 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
771 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
772 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
773 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
774 end if
775 if (cyl_coord) then
776 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
777 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
778 else
779 tau_qq_l = 0._wp; tau_qq_r = 0._wp
780 end if
781 ! Total pressure (replace the usual pressure to define SM)
782 ptot_l = pres%L - tau_nn_l
783 ptot_r = pres%R - tau_nn_r
784
785 ! Symmetrize total pressure when it differs only by floating-point roundoff. WENO reconstruction of a
786 ! uniform field can produce slightly different L/R values at material interfaces due to different
787 ! smoothness indicators. With stiff materials (G~1e9), even 1e-12 relative pTot asymmetry creates O(1)
788 ! spurious stress through the HLLD star-state.
789 if (abs(ptot_r - ptot_l) < 1e-12_wp*max(abs(ptot_l), abs(ptot_r), 1._wp)) then
790 ptot_l = 5e-1_wp*(ptot_l + ptot_r)
791 ptot_r = ptot_l
792 end if
793
794 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho%L, gamma%L, pi_inf%L, qv%L)
795 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho%R, gamma%R, pi_inf%R, qv%R)
796
797 g_l = 0._wp; g_r = 0._wp
798
799# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
800#if defined(MFC_OpenACC)
801# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
802!$acc loop seq
803# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
804#elif defined(MFC_OpenMP)
805# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
806
807# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
808#endif
809# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
810 do i = 1, num_fluids
811 g_l = g_l + alpha_l(i)*gs_rs(i)
812 g_r = g_r + alpha_r(i)*gs_rs(i)
813 end do
814
815 call s_compute_energy(pres%L, alpha_rho_l, alpha_l, vel_rms%L, e%L)
816 call s_compute_energy(pres%R, alpha_rho_r, alpha_r, vel_rms%R, e%R)
817
818 ! Freeze the thermal/kinetic enthalpy used by the EOS sound-speed call before
819 ! adding hypoelastic strain energy to the conservative total energy.
820
821
822# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
823#if defined(MFC_OpenACC)
824# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
825!$acc loop seq
826# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
827#elif defined(MFC_OpenMP)
828# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
829
830# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
831#endif
832# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
833 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
834 shear_cond = (n > 0 .and. p == 0 .and. i == 2) .or. (p > 0 .and. (i == 2 .or. i == 4 .or. i == 5))
835 e%L = e%L + f_elastic_energy(tau_e_l(i), g_l, shear_cond)
836 e%R = e%R + f_elastic_energy(tau_e_r(i), g_r, shear_cond)
837 end do
838
839 ! Compute Riemann states
840
841 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, alpha_l, c%L, alpha_rho_l)
842 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, alpha_r, c%R, alpha_rho_r)
843
844 s_l = min(u_n_l - sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L)), &
845 & u_n_r - sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R)))
846 s_r = max(u_n_r + sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R)), &
847 & u_n_l + sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L)))
848
849 if (p > 0 .and. .not. cyl_coord) then
850 ! 3D Cartesian: 14-state compact basis
851 u_l(1) = alpha_rho_l(1); u_r(1) = alpha_rho_r(1)
852 u_l(2) = alpha_rho_l(2); u_r(2) = alpha_rho_r(2)
853 u_l(3) = rho%L*u_n_l; u_r(3) = rho%R*u_n_r
854 u_l(4) = rho%L*u_t_l; u_r(4) = rho%R*u_t_r
855 u_l(5) = rho%L*u_t2_l; u_r(5) = rho%R*u_t2_r
856 u_l(6) = e%L; u_r(6) = e%R
857 u_l(7) = alpha_l(1); u_r(7) = alpha_r(1)
858 u_l(8) = alpha_l(2); u_r(8) = alpha_r(2)
859 u_l(9) = rho%L*tau_nn_l; u_r(9) = rho%R*tau_nn_r
860 u_l(10) = rho%L*tau_nt_l; u_r(10) = rho%R*tau_nt_r
861 u_l(11) = rho%L*tau_nt2_l; u_r(11) = rho%R*tau_nt2_r
862 u_l(12) = rho%L*tau_tt_l; u_r(12) = rho%R*tau_tt_r
863 u_l(13) = rho%L*tau_t2t2_l; u_r(13) = rho%R*tau_t2t2_r
864 u_l(14) = rho%L*tau_t1t2_l; u_r(14) = rho%R*tau_t1t2_r
865
866 f_l(1) = u_l(1)*u_n_l; f_r(1) = u_r(1)*u_n_r
867 f_l(2) = u_l(2)*u_n_l; f_r(2) = u_r(2)*u_n_r
868 f_l(3) = rho%L*u_n_l*u_n_l + ptot_l
869 f_r(3) = rho%R*u_n_r*u_n_r + ptot_r
870 f_l(4) = rho%L*u_n_l*u_t_l - tau_nt_l
871 f_r(4) = rho%R*u_n_r*u_t_r - tau_nt_r
872 f_l(5) = rho%L*u_n_l*u_t2_l - tau_nt2_l
873 f_r(5) = rho%R*u_n_r*u_t2_r - tau_nt2_r
874 f_l(6) = (e%L + ptot_l)*u_n_l - u_t_l*tau_nt_l - u_t2_l*tau_nt2_l
875 f_r(6) = (e%R + ptot_r)*u_n_r - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r
876 ! Rows 7-14 (volume fractions + stresses) carry the anchor-dependent hat coefficients and are filled
877 ! inside the per-anchor pass loop below.
878 else
879 ! 2D/axisym: 11-state compact basis (unchanged)
880 u_l(1) = alpha_rho_l(1)
881 u_l(2) = alpha_rho_l(2)
882 u_l(3) = rho%L*u_n_l
883 u_l(4) = rho%L*u_t_l
884 u_l(5) = e%L
885 u_l(6) = alpha_l(1)
886 u_l(7) = alpha_l(2)
887 u_l(8) = rho%L*tau_nn_l
888 u_l(9) = rho%L*tau_nt_l
889 u_l(10) = rho%L*tau_tt_l
890 u_l(11) = rho%L*tau_qq_l
891
892 u_r(1) = alpha_rho_r(1)
893 u_r(2) = alpha_rho_r(2)
894 u_r(3) = rho%R*u_n_r
895 u_r(4) = rho%R*u_t_r
896 u_r(5) = e%R
897 u_r(6) = alpha_r(1)
898 u_r(7) = alpha_r(2)
899 u_r(8) = rho%R*tau_nn_r
900 u_r(9) = rho%R*tau_nt_r
901 u_r(10) = rho%R*tau_tt_r
902 u_r(11) = rho%R*tau_qq_r
903
904 f_l(1) = u_l(1)*u_n_l
905 f_l(2) = u_l(2)*u_n_l
906 f_l(3) = rho%L*u_n_l*u_n_l + ptot_l
907 f_l(4) = rho%L*u_n_l*u_t_l - tau_nt_l
908 f_l(5) = (e%L + ptot_l)*u_n_l - u_t_l*tau_nt_l
909
910 f_r(1) = u_r(1)*u_n_r
911 f_r(2) = u_r(2)*u_n_r
912 f_r(3) = rho%R*u_n_r*u_n_r + ptot_r
913 f_r(4) = rho%R*u_n_r*u_t_r - tau_nt_r
914 f_r(5) = (e%R + ptot_r)*u_n_r - u_t_r*tau_nt_r
915 ! Rows 6-11 (volume fractions + stresses) carry the anchor-dependent hat coefficients and are filled
916 ! inside the per-anchor pass loop below.
917 end if
918
919 a_l = rho%L*(s_l - u_n_l)
920 a_r = rho%R*(s_r - u_n_r)
921 denoma = (a_r - a_l)
922
923 s_m = ((ptot_r - ptot_l) + a_l*u_n_l - a_r*u_n_r)/(a_l - a_r + verysmall)
924
925 ! Degenerate wave structure: denom ~ 0 or S_M not in [S_L,S_R]. The test is anchor-independent, so both
926 ! anchored solves below take the same branch.
927 degenerate = (abs(denoma) < verysmall .or. .not. (s_l - verysmall <= s_m .and. s_m <= s_r + verysmall))
928
929 if (.not. degenerate) then
930 ! Anchor-independent pieces of the star region (the anchor state enters only the volume-fraction and
931 ! stress star states)
932 ptot_star = ptot_l + a_l*(s_m - u_n_l)
933
934 ! Signed floor (HLLC-style, see m_riemann_solver_hllc.fpp) on the wave-fan denominators: guards the
935 ! degenerate S_M -> S_L / S_M -> S_R limit, sign-preserving, and a no-op away from it (|denom| >>
936 ! verysmall)
937 rhol_star = rho%L*(s_l - u_n_l)/min(s_l - s_m, -verysmall)
938 rhor_star = rho%R*(s_r - u_n_r)/max(s_r - s_m, verysmall)
939 fac_l = (s_l - u_n_l)/min(s_l - s_m, -verysmall)
940 fac_r = (s_r - u_n_r)/max(s_r - s_m, verysmall)
941
942 e_l_star = (e%L*(u_n_l - s_l) + u_n_l*ptot_l - s_m*ptot_star)/max(s_m - s_l, verysmall)
943 e_r_star = (e%R*(u_n_r - s_r) + u_n_r*ptot_r - s_m*ptot_star)/min(s_m - s_r, -verysmall)
944
945 if (riemann_hypo_adc) then
946 ! ADC sensors depend only on the L/R face states: computed once, shared by both anchored solves
947 sigma_l = ptot_l
948 sigma_r = ptot_r
949 dsigma = sigma_r - sigma_l
950 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
951
952 a_l_ref = sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L))
953 a_r_ref = sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R))
954 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
955
956 du_t = u_t_r - u_t_l
957 dtau_nt = tau_nt_r - tau_nt_l
958 du_t2 = u_t2_r - u_t2_l
959 dtau_nt2 = tau_nt2_r - tau_nt2_l
960
961 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
962 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
963 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 + verysmall)
964
965 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
966
967 phi = exp(-(sensor_combined**adc_power))
968 end if
969 end if
970
971 ! Fused dual-pass: both anchored solves share everything above. The anchor (hat) state and everything it
972 ! touches is evaluated per pass: pass 1 anchors on cell j (hat_L) and writes the flux_rs* set; pass 2
973 ! anchors on cell j+1 (hat_R) and writes the flux_hatR_rs* set.
974
975# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
976#if defined(MFC_OpenACC)
977# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
978!$acc loop seq
979# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
980#elif defined(MFC_OpenMP)
981# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
982
983# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
984#endif
985# 485 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
986 do ipass = 1, 2
987 do i = 1, eqn_idx%cont%end
988 alpha_rho_hat(i) = q_prim_vf(i)%sf(j + ipass - 1, k, l)
989# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
990 end do
991 do i = 1, num_fluids
992 alpha_hat(i) = q_prim_vf(eqn_idx%E + i)%sf(j + ipass - 1, k, l)
993# 491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
994 end do
995
996# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
997#if defined(MFC_OpenACC)
998# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
999!$acc loop seq
1000# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1001#elif defined(MFC_OpenMP)
1002# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1003
1004# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1005#endif
1006# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1007 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1008 tau_e_hat(i) = q_prim_vf(eqn_idx%stress%beg - 1 + i)%sf(j + ipass - 1, k, l)
1009# 495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1010 end do
1011
1012 ! Anchor-state directional aliases (mirrors the L/R alias block above)
1013 tau_nt2_hat = 0._wp; tau_t2t2_hat = 0._wp; tau_t1t2_hat = 0._wp
1014 tau_nn_hat = tau_e_hat(stress_perm(1))
1015 if (n > 0) then
1016 tau_nt_hat = tau_e_hat(stress_perm(2))
1017 tau_tt_hat = tau_e_hat(stress_perm(3))
1018 if (p > 0) then
1019 tau_nt2_hat = tau_e_hat(stress_perm(4))
1020 tau_t1t2_hat = tau_e_hat(stress_perm(5))
1021 tau_t2t2_hat = tau_e_hat(stress_perm(6))
1022 end if
1023 end if
1024 if (cyl_coord) then
1025 tau_qq_hat = tau_e_hat(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
1026 else
1027 tau_qq_hat = 0._wp
1028 end if
1029
1030 rho_hat = 0._wp
1031
1032# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1033#if defined(MFC_OpenACC)
1034# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1035!$acc loop seq
1036# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1037#elif defined(MFC_OpenMP)
1038# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1039
1040# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1041#endif
1042# 517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1043 do i = 1, num_fluids
1044 rho_hat = rho_hat + alpha_rho_hat(i)
1045 end do
1046
1047 g_hat = 0._wp
1048
1049# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1050#if defined(MFC_OpenACC)
1051# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1052!$acc loop seq
1053# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1054#elif defined(MFC_OpenMP)
1055# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1056
1057# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1058#endif
1059# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1060 do i = 1, num_fluids
1061 g_hat = g_hat + alpha_hat(i)*gs_rs(i)
1062 end do
1063
1064 ! Two-component 2D only (enforced by checker restrictions)
1065 k_hat = 0._wp
1066 if (alt_soundspeed) then
1067 pres_hat = q_prim_vf(eqn_idx%E)%sf(j + ipass - 1, k, l)
1068# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1069 alpha_hat_q = alpha_hat(1)
1070 alpha_rho_hat_q = alpha_rho_hat(1)
1071 call s_phase_bulk_modulus(pres_hat, alpha_hat_q, alpha_rho_hat_q, 1, blkmod1_hat)
1072 alpha_hat_q = alpha_hat(2)
1073 alpha_rho_hat_q = alpha_rho_hat(2)
1074 call s_phase_bulk_modulus(pres_hat, alpha_hat_q, alpha_rho_hat_q, 2, blkmod2_hat)
1075 blkmod1_hat = blkmod1_hat + (4._wp/3._wp)*gs_rs(1)
1076 blkmod2_hat = blkmod2_hat + (4._wp/3._wp)*gs_rs(2)
1077 k_hat = alpha_hat(1)*alpha_hat(2)*(blkmod2_hat - blkmod1_hat)/(alpha_hat(1)*blkmod2_hat &
1078 & + alpha_hat(2)*blkmod1_hat + verysmall)
1079 end if
1080 c_hat_1 = alpha_hat(1) + k_hat
1081 c_hat_2 = alpha_hat(2) - k_hat
1082
1083 if (p > 0 .and. .not. cyl_coord) then
1084 ! 3D Cartesian: anchor-dependent rows (7-14) of the 14-state flux
1085 f_l(7) = u_l(7)*u_n_l - c_hat_1*u_n_l
1086 f_r(7) = u_r(7)*u_n_r - c_hat_1*u_n_r
1087 f_l(8) = u_l(8)*u_n_l - c_hat_2*u_n_l
1088 f_r(8) = u_r(8)*u_n_r - c_hat_2*u_n_r
1089 f_l(9) = u_l(9)*u_n_l - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_l
1090 f_r(9) = u_r(9)*u_n_r - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_r
1091 f_l(10) = u_l(10)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t_l
1092 f_r(10) = u_r(10)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t_r
1093 f_l(11) = u_l(11)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t2_l
1094 f_r(11) = u_r(11)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t2_r
1095 f_l(12) = u_l(12)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_l &
1096 & - 2._wp*rho_hat*tau_nt_hat*u_t_l
1097 f_r(12) = u_r(12)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_r &
1098 & - 2._wp*rho_hat*tau_nt_hat*u_t_r
1099 f_l(13) = u_l(13)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_t2t2_hat)*u_n_l &
1100 & - 2._wp*rho_hat*tau_nt2_hat*u_t2_l
1101 f_r(13) = u_r(13)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_t2t2_hat)*u_n_r &
1102 & - 2._wp*rho_hat*tau_nt2_hat*u_t2_r
1103 f_l(14) = u_l(14)*u_n_l + rho_hat*tau_t1t2_hat*u_n_l - rho_hat*tau_nt2_hat*u_t_l &
1104 & - rho_hat*tau_nt_hat*u_t2_l
1105 f_r(14) = u_r(14)*u_n_r + rho_hat*tau_t1t2_hat*u_n_r - rho_hat*tau_nt2_hat*u_t_r &
1106 & - rho_hat*tau_nt_hat*u_t2_r
1107 else
1108 ! 2D/axisym: anchor-dependent rows (6-11) of the 11-state flux
1109 f_l(6) = u_l(6)*u_n_l - c_hat_1*u_n_l
1110 f_r(6) = u_r(6)*u_n_r - c_hat_1*u_n_r
1111 f_l(7) = u_l(7)*u_n_l - c_hat_2*u_n_l
1112 f_r(7) = u_r(7)*u_n_r - c_hat_2*u_n_r
1113 f_l(8) = u_l(8)*u_n_l - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_l
1114 f_r(8) = u_r(8)*u_n_r - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_r
1115 f_l(9) = u_l(9)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t_l
1116 f_r(9) = u_r(9)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t_r
1117 f_l(10) = u_l(10)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_l &
1118 & - 2._wp*rho_hat*tau_nt_hat*u_t_l
1119 f_r(10) = u_r(10)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_r &
1120 & - 2._wp*rho_hat*tau_nt_hat*u_t_r
1121 f_l(11) = u_l(11)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_qq_hat)*u_n_l
1122 f_r(11) = u_r(11)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_qq_hat)*u_n_r
1123 end if
1124
1125 ! The effective shear stiffness is anchor-dependent. Resolve its three numerical states before
1126 ! forming C_NC: positive keeps HLLD; zero to cancellation accuracy takes the finite HLLC limit;
1127 ! materially negative (loss of the assumed real shear subfan) rejects the whole anchored fan.
1128 ! The tolerance is relative only to the two terms being added, not to an acoustic/material scale.
1129 fan_fallback = degenerate
1130 shear_degenerate = .false.
1131 if (.not. fan_fallback) then
1132 g_eff = g_hat + tau_nn_hat
1133 g_eff_tol = g_eff_roundoff_factor*epsilon(1._wp)*(abs(g_hat) + abs(tau_nn_hat))
1134
1135 if (.not. (g_eff >= -g_eff_tol)) then
1136 ! Materially negative, or unordered (NaN): no real five-wave shear fan.
1137 fan_fallback = .true.
1138 else if (g_eff <= g_eff_tol) then
1139 shear_degenerate = .true.
1140 s_lstar = s_m
1141 s_rstar = s_m
1142 else
1143 c_nc = rho_hat*g_eff
1144 if (.not. (c_nc > 0._wp)) then
1145 ! Positive G_eff below the representable C_NC range is numerically degenerate;
1146 ! nonpositive/unordered rho_hat is invalid for the same construction.
1147 shear_degenerate = (rho_hat > 0._wp)
1148 fan_fallback = .not. shear_degenerate
1149 s_lstar = s_m
1150 s_rstar = s_m
1151 else
1152 sqrtc_nc = sqrt(c_nc)
1153 s_lstar = s_m - sqrtc_nc/rhol_star
1154 s_rstar = s_m + sqrtc_nc/rhor_star
1155 ! A speed-only clamp would break the corresponding Rankine--Hugoniot jump.
1156 fan_fallback = (s_lstar < s_l .or. s_rstar > s_r)
1157 end if
1158 end if
1159 end if
1160
1161 if (fan_fallback) then
1162 ! HLL (or one-sided) fallback for an invalid wave structure
1163 if (s_l < 0._wp .and. s_r > 0._wp) then
1164 do i = 1, ncomp
1165 f_hlld(i) = f_hll_flux(s_l, s_r, f_l(i), f_r(i), u_l(i), u_r(i))
1166 end do
1167 else if (s_l >= 0._wp) then
1168 f_hlld(1:ncomp) = f_l(1:ncomp)
1169 else
1170 f_hlld(1:ncomp) = f_r(1:ncomp)
1171 end if
1172 ! Initialize star-state variables to safe values so no path reads uninitialized memory
1173 ! (a subsequent valid pass restores what it needs). Fallback face exports do not use
1174 ! them: they take the HLL/one-sided traces computed below.
1175 ptot_star = 5e-1_wp*(ptot_l + ptot_r)
1176 s_lstar = s_l
1177 s_rstar = s_r
1178 u_t_star = 5e-1_wp*(u_t_l + u_t_r)
1179 tau_nn_l_star = tau_nn_l
1180 tau_nn_r_star = tau_nn_r
1181 tau_qq_l_star = tau_qq_l
1182 tau_qq_r_star = tau_qq_r
1183 else
1184 ! A preceding anchored pass may have taken the fallback and assigned a safe face value.
1185 ! Restore the anchor-independent HLLD contact pressure for this valid pass.
1186 ptot_star = ptot_l + a_l*(s_m - u_n_l)
1187
1188 if (shear_degenerate) then
1189 ! Degenerate shear impedance: collapse inner waves to HLLC
1190 u_t_star = 5e-1_wp*(u_t_l + u_t_r)
1191 tau_nt_star = 5e-1_wp*(tau_nt_l + tau_nt_r)
1192 u_t2_star = 5e-1_wp*(u_t2_l + u_t2_r)
1193 tau_nt2_star = 5e-1_wp*(tau_nt2_l + tau_nt2_r)
1194 else
1195 u_t_star = 5e-1_wp*((tau_nt_r - tau_nt_l)/sqrtc_nc + (u_t_r + u_t_l))
1196 tau_nt_star = 5e-1_wp*((u_t_r - u_t_l)*sqrtc_nc + (tau_nt_r + tau_nt_l))
1197 u_t2_star = 5e-1_wp*((tau_nt2_r - tau_nt2_l)/sqrtc_nc + (u_t2_r + u_t2_l))
1198 tau_nt2_star = 5e-1_wp*((u_t2_r - u_t2_l)*sqrtc_nc + (tau_nt2_r + tau_nt2_l))
1199 end if
1200
1201 ! Outer-wave stress star states: one formula family over the components. ELC is
1202 ! the anchor-side elastic coefficient (deviatoric 4/3 vs 2/3 structure; t1t2
1203 ! carries no G term) and SGN = -1/+1 the jump sign of the component.
1204# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1205# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1206 tau_nn_l_star = tau_nn_l - (rho_hat*(g_hat*4._wp/3._wp + tau_nn_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
1207# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1208# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1209 tau_nn_r_star = tau_nn_r - (rho_hat*(g_hat*4._wp/3._wp + tau_nn_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
1210# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1211# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1212# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1213# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1214 tau_tt_l_star = tau_tt_l + (rho_hat*(g_hat*2._wp/3._wp + tau_tt_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
1215# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1216# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1217 tau_tt_r_star = tau_tt_r + (rho_hat*(g_hat*2._wp/3._wp + tau_tt_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
1218# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1219# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1220# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1221# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1222 tau_t2t2_l_star = tau_t2t2_l + (rho_hat*(g_hat*2._wp/3._wp + tau_t2t2_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
1223# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1224# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1225 tau_t2t2_r_star = tau_t2t2_r + (rho_hat*(g_hat*2._wp/3._wp + tau_t2t2_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
1226# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1227# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1228# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1229# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1230 tau_t1t2_l_star = tau_t1t2_l + (rho_hat*tau_t1t2_hat*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
1231# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1232# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1233 tau_t1t2_r_star = tau_t1t2_r + (rho_hat*tau_t1t2_hat*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
1234# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1235# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1236# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1237# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1238 tau_qq_l_star = tau_qq_l + (rho_hat*(g_hat*2._wp/3._wp + tau_qq_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
1239# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1240# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1241 tau_qq_r_star = tau_qq_r + (rho_hat*(g_hat*2._wp/3._wp + tau_qq_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
1242# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1243# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1244# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1245
1246 if (shear_degenerate) then
1247 ! Degenerate: no inner wave correction
1248 tau_tt_l_starstar = tau_tt_l_star
1249 tau_tt_r_starstar = tau_tt_r_star
1250 tau_t2t2_l_starstar = tau_t2t2_l_star
1251 tau_t2t2_r_starstar = tau_t2t2_r_star
1252 tau_t1t2_l_starstar = tau_t1t2_l_star
1253 tau_t1t2_r_starstar = tau_t1t2_r_star
1254 e_l_starstar = e_l_star
1255 e_r_starstar = e_r_star
1256 else
1257 tau_tt_l_starstar = tau_tt_l_star + 2._wp*rho_hat*tau_nt_hat/sqrtc_nc*(u_t_star - u_t_l)
1258 tau_tt_r_starstar = tau_tt_r_star - 2._wp*rho_hat*tau_nt_hat/sqrtc_nc*(u_t_star - u_t_r)
1259 tau_t2t2_l_starstar = tau_t2t2_l_star + 2._wp*rho_hat*tau_nt2_hat/sqrtc_nc*(u_t2_star &
1260 & - u_t2_l)
1261 tau_t2t2_r_starstar = tau_t2t2_r_star - 2._wp*rho_hat*tau_nt2_hat/sqrtc_nc*(u_t2_star &
1262 & - u_t2_r)
1263 tau_t1t2_l_starstar = tau_t1t2_l_star + rho_hat*(tau_nt2_hat*(u_t_star - u_t_l) &
1264 & + tau_nt_hat*(u_t2_star - u_t2_l))/sqrtc_nc
1265 tau_t1t2_r_starstar = tau_t1t2_r_star - rho_hat*(tau_nt2_hat*(u_t_star - u_t_r) &
1266 & + tau_nt_hat*(u_t2_star - u_t2_r))/sqrtc_nc
1267 e_l_starstar = e_l_star + (rhol_star/sqrtc_nc)*((u_t_star*tau_nt_star - u_t_l*tau_nt_l) &
1268 & + (u_t2_star*tau_nt2_star - u_t2_l*tau_nt2_l))
1269 e_r_starstar = e_r_star - (rhor_star/sqrtc_nc)*((u_t_star*tau_nt_star - u_t_r*tau_nt_r) &
1270 & + (u_t2_star*tau_nt2_star - u_t2_r*tau_nt2_r))
1271 end if
1272
1273 alpha1_l_star = (alpha_l(1)*(s_l - u_n_l) - c_hat_1*(s_m - u_n_l))/min(s_l - s_m, -verysmall)
1274 alpha1_r_star = (alpha_r(1)*(s_r - u_n_r) - c_hat_1*(s_m - u_n_r))/max(s_r - s_m, verysmall)
1275
1276 alpha2_l_star = (alpha_l(2)*(s_l - u_n_l) - c_hat_2*(s_m - u_n_l))/min(s_l - s_m, -verysmall)
1277 alpha2_r_star = (alpha_r(2)*(s_r - u_n_r) - c_hat_2*(s_m - u_n_r))/max(s_r - s_m, verysmall)
1278
1279 ! HLLD flux, register-diet form: pick the wave-fan zone once (it is
1280 ! component-independent), then fold the selected side's star/starstar states into
1281 ! F_hlld one component at a time through the scalars us_c/uss_c (no fan arrays
1282 ! survive). The L and R sides are mirror images and the per-component statements
1283 ! share one shape, so the whole fold is emitted from one Fypp template driven by
1284 ! HLLD_FAN_SIDES and the HLLD_FAN_COMPS_3D/2D tables above. Per-component operation
1285 ! order matches the materialized form, so the flux is -O0 bit-identical. Do NOT
1286 ! re-expand into per-region temp arrays (or reorder the fold) without re-checking
1287 ! GPU register spill and the -O0 exactness gate.
1288
1289 zone = f_hlld_wave_zone(s_l, s_lstar, s_m, s_rstar, s_r)
1290
1291 if (zone == 0) then
1292 f_hlld(1:ncomp) = f_l(1:ncomp)
1293 else if (zone == 5) then
1294 f_hlld(1:ncomp) = f_r(1:ncomp)
1295# 726 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1296 else if (zone == 1 .or. zone == 2) then
1297# 727 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1298 ! L side of the fan: per component, us_c/uss_c are the selected side's
1299# 728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1300 ! star/starstar states (the old F_starL is folded into the first F_hlld
1301# 729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1302 ! statement; the starstar correction applies in zone 2 only, with the
1303# 730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1304 ! left-associative order of the materialized form preserved)
1305 if (p > 0 .and. .not. cyl_coord) then
1306# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1307 us_c = u_l(1)*fac_l
1308# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1309 uss_c = us_c
1310# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1311 f_hlld(1) = f_l(1) + s_l*(us_c - u_l(1))
1312# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1313 if (zone == 2) f_hlld(1) = f_hlld(1) + s_lstar*(uss_c &
1314# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1315 & - us_c)
1316# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1317 us_c = u_l(2)*fac_l
1318# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1319 uss_c = us_c
1320# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1321 f_hlld(2) = f_l(2) + s_l*(us_c - u_l(2))
1322# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1323 if (zone == 2) f_hlld(2) = f_hlld(2) + s_lstar*(uss_c &
1324# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1325 & - us_c)
1326# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1327 us_c = rhol_star*s_m
1328# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1329 uss_c = us_c
1330# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1331 f_hlld(3) = f_l(3) + s_l*(us_c - u_l(3))
1332# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1333 if (zone == 2) f_hlld(3) = f_hlld(3) + s_lstar*(uss_c &
1334# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1335 & - us_c)
1336# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1337 us_c = rhol_star*u_t_l
1338# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1339 uss_c = rhol_star*u_t_star
1340# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1341 f_hlld(4) = f_l(4) + s_l*(us_c - u_l(4))
1342# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1343 if (zone == 2) f_hlld(4) = f_hlld(4) + s_lstar*(uss_c &
1344# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1345 & - us_c)
1346# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1347 us_c = rhol_star*u_t2_l
1348# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1349 uss_c = rhol_star*u_t2_star
1350# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1351 f_hlld(5) = f_l(5) + s_l*(us_c - u_l(5))
1352# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1353 if (zone == 2) f_hlld(5) = f_hlld(5) + s_lstar*(uss_c &
1354# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1355 & - us_c)
1356# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1357 us_c = e_l_star
1358# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1359 uss_c = e_l_starstar
1360# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1361 f_hlld(6) = f_l(6) + s_l*(us_c - u_l(6))
1362# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1363 if (zone == 2) f_hlld(6) = f_hlld(6) + s_lstar*(uss_c &
1364# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1365 & - us_c)
1366# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1367 us_c = alpha1_l_star
1368# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1369 uss_c = us_c
1370# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1371 f_hlld(7) = f_l(7) + s_l*(us_c - u_l(7))
1372# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1373 if (zone == 2) f_hlld(7) = f_hlld(7) + s_lstar*(uss_c &
1374# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1375 & - us_c)
1376# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1377 us_c = alpha2_l_star
1378# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1379 uss_c = us_c
1380# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1381 f_hlld(8) = f_l(8) + s_l*(us_c - u_l(8))
1382# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1383 if (zone == 2) f_hlld(8) = f_hlld(8) + s_lstar*(uss_c &
1384# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1385 & - us_c)
1386# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1387 us_c = rhol_star*tau_nn_l_star
1388# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1389 uss_c = us_c
1390# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1391 f_hlld(9) = f_l(9) + s_l*(us_c - u_l(9))
1392# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1393 if (zone == 2) f_hlld(9) = f_hlld(9) + s_lstar*(uss_c &
1394# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1395 & - us_c)
1396# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1397 us_c = rhol_star*tau_nt_l
1398# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1399 uss_c = rhol_star*tau_nt_star
1400# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1401 f_hlld(10) = f_l(10) + s_l*(us_c - u_l(10))
1402# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1403 if (zone == 2) f_hlld(10) = f_hlld(10) + s_lstar*(uss_c &
1404# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1405 & - us_c)
1406# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1407 us_c = rhol_star*tau_nt2_l
1408# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1409 uss_c = rhol_star*tau_nt2_star
1410# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1411 f_hlld(11) = f_l(11) + s_l*(us_c - u_l(11))
1412# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1413 if (zone == 2) f_hlld(11) = f_hlld(11) + s_lstar*(uss_c &
1414# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1415 & - us_c)
1416# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1417 us_c = rhol_star*tau_tt_l_star
1418# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1419 uss_c = rhol_star*tau_tt_l_starstar
1420# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1421 f_hlld(12) = f_l(12) + s_l*(us_c - u_l(12))
1422# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1423 if (zone == 2) f_hlld(12) = f_hlld(12) + s_lstar*(uss_c &
1424# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1425 & - us_c)
1426# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1427 us_c = rhol_star*tau_t2t2_l_star
1428# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1429 uss_c = rhol_star*tau_t2t2_l_starstar
1430# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1431 f_hlld(13) = f_l(13) + s_l*(us_c - u_l(13))
1432# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1433 if (zone == 2) f_hlld(13) = f_hlld(13) + s_lstar*(uss_c &
1434# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1435 & - us_c)
1436# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1437 us_c = rhol_star*tau_t1t2_l_star
1438# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1439 uss_c = rhol_star*tau_t1t2_l_starstar
1440# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1441 f_hlld(14) = f_l(14) + s_l*(us_c - u_l(14))
1442# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1443 if (zone == 2) f_hlld(14) = f_hlld(14) + s_lstar*(uss_c &
1444# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1445 & - us_c)
1446# 739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1447 else
1448# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1449 us_c = u_l(1)*fac_l
1450# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1451 uss_c = us_c
1452# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1453 f_hlld(1) = f_l(1) + s_l*(us_c - u_l(1))
1454# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1455 if (zone == 2) f_hlld(1) = f_hlld(1) + s_lstar*(uss_c &
1456# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1457 & - us_c)
1458# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1459 us_c = u_l(2)*fac_l
1460# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1461 uss_c = us_c
1462# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1463 f_hlld(2) = f_l(2) + s_l*(us_c - u_l(2))
1464# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1465 if (zone == 2) f_hlld(2) = f_hlld(2) + s_lstar*(uss_c &
1466# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1467 & - us_c)
1468# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1469 us_c = rhol_star*s_m
1470# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1471 uss_c = us_c
1472# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1473 f_hlld(3) = f_l(3) + s_l*(us_c - u_l(3))
1474# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1475 if (zone == 2) f_hlld(3) = f_hlld(3) + s_lstar*(uss_c &
1476# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1477 & - us_c)
1478# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1479 us_c = rhol_star*u_t_l
1480# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1481 uss_c = rhol_star*u_t_star
1482# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1483 f_hlld(4) = f_l(4) + s_l*(us_c - u_l(4))
1484# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1485 if (zone == 2) f_hlld(4) = f_hlld(4) + s_lstar*(uss_c &
1486# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1487 & - us_c)
1488# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1489 us_c = e_l_star
1490# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1491 uss_c = e_l_starstar
1492# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1493 f_hlld(5) = f_l(5) + s_l*(us_c - u_l(5))
1494# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1495 if (zone == 2) f_hlld(5) = f_hlld(5) + s_lstar*(uss_c &
1496# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1497 & - us_c)
1498# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1499 us_c = alpha1_l_star
1500# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1501 uss_c = us_c
1502# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1503 f_hlld(6) = f_l(6) + s_l*(us_c - u_l(6))
1504# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1505 if (zone == 2) f_hlld(6) = f_hlld(6) + s_lstar*(uss_c &
1506# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1507 & - us_c)
1508# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1509 us_c = alpha2_l_star
1510# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1511 uss_c = us_c
1512# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1513 f_hlld(7) = f_l(7) + s_l*(us_c - u_l(7))
1514# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1515 if (zone == 2) f_hlld(7) = f_hlld(7) + s_lstar*(uss_c &
1516# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1517 & - us_c)
1518# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1519 us_c = rhol_star*tau_nn_l_star
1520# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1521 uss_c = us_c
1522# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1523 f_hlld(8) = f_l(8) + s_l*(us_c - u_l(8))
1524# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1525 if (zone == 2) f_hlld(8) = f_hlld(8) + s_lstar*(uss_c &
1526# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1527 & - us_c)
1528# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1529 us_c = rhol_star*tau_nt_l
1530# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1531 uss_c = rhol_star*tau_nt_star
1532# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1533 f_hlld(9) = f_l(9) + s_l*(us_c - u_l(9))
1534# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1535 if (zone == 2) f_hlld(9) = f_hlld(9) + s_lstar*(uss_c &
1536# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1537 & - us_c)
1538# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1539 us_c = rhol_star*tau_tt_l_star
1540# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1541 uss_c = rhol_star*tau_tt_l_starstar
1542# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1543 f_hlld(10) = f_l(10) + s_l*(us_c - u_l(10))
1544# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1545 if (zone == 2) f_hlld(10) = f_hlld(10) + s_lstar*(uss_c &
1546# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1547 & - us_c)
1548# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1549 us_c = rhol_star*tau_qq_l_star
1550# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1551 uss_c = us_c
1552# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1553 f_hlld(11) = f_l(11) + s_l*(us_c - u_l(11))
1554# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1555 if (zone == 2) f_hlld(11) = f_hlld(11) + s_lstar*(uss_c &
1556# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1557 & - us_c)
1558# 747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1559 end if
1560# 726 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1561 else if (zone == 3 .or. zone == 4) then
1562# 727 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1563 ! R side of the fan: per component, us_c/uss_c are the selected side's
1564# 728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1565 ! star/starstar states (the old F_starR is folded into the first F_hlld
1566# 729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1567 ! statement; the starstar correction applies in zone 3 only, with the
1568# 730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1569 ! left-associative order of the materialized form preserved)
1570 if (p > 0 .and. .not. cyl_coord) then
1571# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1572 us_c = u_r(1)*fac_r
1573# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1574 uss_c = us_c
1575# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1576 f_hlld(1) = f_r(1) + s_r*(us_c - u_r(1))
1577# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1578 if (zone == 3) f_hlld(1) = f_hlld(1) + s_rstar*(uss_c &
1579# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1580 & - us_c)
1581# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1582 us_c = u_r(2)*fac_r
1583# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1584 uss_c = us_c
1585# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1586 f_hlld(2) = f_r(2) + s_r*(us_c - u_r(2))
1587# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1588 if (zone == 3) f_hlld(2) = f_hlld(2) + s_rstar*(uss_c &
1589# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1590 & - us_c)
1591# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1592 us_c = rhor_star*s_m
1593# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1594 uss_c = us_c
1595# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1596 f_hlld(3) = f_r(3) + s_r*(us_c - u_r(3))
1597# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1598 if (zone == 3) f_hlld(3) = f_hlld(3) + s_rstar*(uss_c &
1599# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1600 & - us_c)
1601# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1602 us_c = rhor_star*u_t_r
1603# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1604 uss_c = rhor_star*u_t_star
1605# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1606 f_hlld(4) = f_r(4) + s_r*(us_c - u_r(4))
1607# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1608 if (zone == 3) f_hlld(4) = f_hlld(4) + s_rstar*(uss_c &
1609# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1610 & - us_c)
1611# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1612 us_c = rhor_star*u_t2_r
1613# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1614 uss_c = rhor_star*u_t2_star
1615# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1616 f_hlld(5) = f_r(5) + s_r*(us_c - u_r(5))
1617# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1618 if (zone == 3) f_hlld(5) = f_hlld(5) + s_rstar*(uss_c &
1619# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1620 & - us_c)
1621# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1622 us_c = e_r_star
1623# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1624 uss_c = e_r_starstar
1625# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1626 f_hlld(6) = f_r(6) + s_r*(us_c - u_r(6))
1627# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1628 if (zone == 3) f_hlld(6) = f_hlld(6) + s_rstar*(uss_c &
1629# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1630 & - us_c)
1631# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1632 us_c = alpha1_r_star
1633# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1634 uss_c = us_c
1635# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1636 f_hlld(7) = f_r(7) + s_r*(us_c - u_r(7))
1637# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1638 if (zone == 3) f_hlld(7) = f_hlld(7) + s_rstar*(uss_c &
1639# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1640 & - us_c)
1641# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1642 us_c = alpha2_r_star
1643# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1644 uss_c = us_c
1645# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1646 f_hlld(8) = f_r(8) + s_r*(us_c - u_r(8))
1647# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1648 if (zone == 3) f_hlld(8) = f_hlld(8) + s_rstar*(uss_c &
1649# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1650 & - us_c)
1651# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1652 us_c = rhor_star*tau_nn_r_star
1653# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1654 uss_c = us_c
1655# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1656 f_hlld(9) = f_r(9) + s_r*(us_c - u_r(9))
1657# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1658 if (zone == 3) f_hlld(9) = f_hlld(9) + s_rstar*(uss_c &
1659# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1660 & - us_c)
1661# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1662 us_c = rhor_star*tau_nt_r
1663# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1664 uss_c = rhor_star*tau_nt_star
1665# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1666 f_hlld(10) = f_r(10) + s_r*(us_c - u_r(10))
1667# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1668 if (zone == 3) f_hlld(10) = f_hlld(10) + s_rstar*(uss_c &
1669# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1670 & - us_c)
1671# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1672 us_c = rhor_star*tau_nt2_r
1673# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1674 uss_c = rhor_star*tau_nt2_star
1675# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1676 f_hlld(11) = f_r(11) + s_r*(us_c - u_r(11))
1677# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1678 if (zone == 3) f_hlld(11) = f_hlld(11) + s_rstar*(uss_c &
1679# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1680 & - us_c)
1681# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1682 us_c = rhor_star*tau_tt_r_star
1683# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1684 uss_c = rhor_star*tau_tt_r_starstar
1685# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1686 f_hlld(12) = f_r(12) + s_r*(us_c - u_r(12))
1687# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1688 if (zone == 3) f_hlld(12) = f_hlld(12) + s_rstar*(uss_c &
1689# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1690 & - us_c)
1691# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1692 us_c = rhor_star*tau_t2t2_r_star
1693# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1694 uss_c = rhor_star*tau_t2t2_r_starstar
1695# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1696 f_hlld(13) = f_r(13) + s_r*(us_c - u_r(13))
1697# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1698 if (zone == 3) f_hlld(13) = f_hlld(13) + s_rstar*(uss_c &
1699# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1700 & - us_c)
1701# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1702 us_c = rhor_star*tau_t1t2_r_star
1703# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1704 uss_c = rhor_star*tau_t1t2_r_starstar
1705# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1706 f_hlld(14) = f_r(14) + s_r*(us_c - u_r(14))
1707# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1708 if (zone == 3) f_hlld(14) = f_hlld(14) + s_rstar*(uss_c &
1709# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1710 & - us_c)
1711# 739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1712 else
1713# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1714 us_c = u_r(1)*fac_r
1715# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1716 uss_c = us_c
1717# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1718 f_hlld(1) = f_r(1) + s_r*(us_c - u_r(1))
1719# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1720 if (zone == 3) f_hlld(1) = f_hlld(1) + s_rstar*(uss_c &
1721# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1722 & - us_c)
1723# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1724 us_c = u_r(2)*fac_r
1725# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1726 uss_c = us_c
1727# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1728 f_hlld(2) = f_r(2) + s_r*(us_c - u_r(2))
1729# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1730 if (zone == 3) f_hlld(2) = f_hlld(2) + s_rstar*(uss_c &
1731# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1732 & - us_c)
1733# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1734 us_c = rhor_star*s_m
1735# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1736 uss_c = us_c
1737# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1738 f_hlld(3) = f_r(3) + s_r*(us_c - u_r(3))
1739# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1740 if (zone == 3) f_hlld(3) = f_hlld(3) + s_rstar*(uss_c &
1741# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1742 & - us_c)
1743# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1744 us_c = rhor_star*u_t_r
1745# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1746 uss_c = rhor_star*u_t_star
1747# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1748 f_hlld(4) = f_r(4) + s_r*(us_c - u_r(4))
1749# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1750 if (zone == 3) f_hlld(4) = f_hlld(4) + s_rstar*(uss_c &
1751# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1752 & - us_c)
1753# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1754 us_c = e_r_star
1755# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1756 uss_c = e_r_starstar
1757# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1758 f_hlld(5) = f_r(5) + s_r*(us_c - u_r(5))
1759# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1760 if (zone == 3) f_hlld(5) = f_hlld(5) + s_rstar*(uss_c &
1761# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1762 & - us_c)
1763# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1764 us_c = alpha1_r_star
1765# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1766 uss_c = us_c
1767# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1768 f_hlld(6) = f_r(6) + s_r*(us_c - u_r(6))
1769# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1770 if (zone == 3) f_hlld(6) = f_hlld(6) + s_rstar*(uss_c &
1771# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1772 & - us_c)
1773# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1774 us_c = alpha2_r_star
1775# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1776 uss_c = us_c
1777# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1778 f_hlld(7) = f_r(7) + s_r*(us_c - u_r(7))
1779# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1780 if (zone == 3) f_hlld(7) = f_hlld(7) + s_rstar*(uss_c &
1781# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1782 & - us_c)
1783# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1784 us_c = rhor_star*tau_nn_r_star
1785# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1786 uss_c = us_c
1787# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1788 f_hlld(8) = f_r(8) + s_r*(us_c - u_r(8))
1789# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1790 if (zone == 3) f_hlld(8) = f_hlld(8) + s_rstar*(uss_c &
1791# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1792 & - us_c)
1793# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1794 us_c = rhor_star*tau_nt_r
1795# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1796 uss_c = rhor_star*tau_nt_star
1797# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1798 f_hlld(9) = f_r(9) + s_r*(us_c - u_r(9))
1799# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1800 if (zone == 3) f_hlld(9) = f_hlld(9) + s_rstar*(uss_c &
1801# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1802 & - us_c)
1803# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1804 us_c = rhor_star*tau_tt_r_star
1805# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1806 uss_c = rhor_star*tau_tt_r_starstar
1807# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1808 f_hlld(10) = f_r(10) + s_r*(us_c - u_r(10))
1809# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1810 if (zone == 3) f_hlld(10) = f_hlld(10) + s_rstar*(uss_c &
1811# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1812 & - us_c)
1813# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1814 us_c = rhor_star*tau_qq_r_star
1815# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1816 uss_c = us_c
1817# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1818 f_hlld(11) = f_r(11) + s_r*(us_c - u_r(11))
1819# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1820 if (zone == 3) f_hlld(11) = f_hlld(11) + s_rstar*(uss_c &
1821# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1822 & - us_c)
1823# 747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1824 end if
1825# 749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1826 end if
1827
1828 ! ADC blending (HLLD / HLL)
1829
1830 if (riemann_hypo_adc) then
1831 ! Register-diet form: the HLL flux enters per component as the scalar F_HLL_c
1832 ! instead of a materialized F_HLL array; outside the subsonic fan F_HLL equals
1833 ! F_hlld and the identity blend is kept explicitly so the arithmetic (including
1834 ! signed-zero behavior) matches the array form bit-for-bit.
1835 ! phi is anchor-independent: computed once in the shared section above
1836 if (s_l < 0._wp .and. s_r > 0._wp) then
1837 do i = 1, ncomp
1838 f_hll_c = f_hll_flux(s_l, s_r, f_l(i), f_r(i), u_l(i), u_r(i))
1839 f_hlld(i) = f_hll_c + phi*(f_hlld(i) - f_hll_c)
1840 end do
1841 else
1842 do i = 1, ncomp
1843 f_hll_c = f_hlld(i)
1844 f_hlld(i) = f_hll_c + phi*(f_hlld(i) - f_hll_c)
1845 end do
1846 end if
1847 end if
1848 end if
1849
1850 ! HLL face traces for the axisymmetric completion: consumed by the ADC face-state blend on
1851 ! valid fans and by the face exports on fallback faces (whose conservative flux is the
1852 ! matching HLL/one-sided flux). Rows 8/11 carry the pass's anchored folds, so the traces
1853 ! are anchor-dependent, like the ADC reference they generalize.
1854 if (cyl_coord .and. (riemann_hypo_adc .or. fan_fallback)) then
1855 if (0._wp <= s_l) then
1856 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l
1857 p_face_hll = pres%L; tau_qq_face_hll = tau_qq_l
1858 else if (s_r <= 0._wp) then
1859 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r
1860 p_face_hll = pres%R; tau_qq_face_hll = tau_qq_r
1861 else
1862 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
1863 u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
1864 ! Only HLL-state components 1, 2, 3, 8 and 11 feed the axisym trace
1865 u_hll_c = (s_r*u_r(1) - s_l*u_l(1) - (f_r(1) - f_l(1)))/(s_r - s_l + verysmall)
1866 rho_hll = u_hll_c
1867 u_hll_c = (s_r*u_r(2) - s_l*u_l(2) - (f_r(2) - f_l(2)))/(s_r - s_l + verysmall)
1868 rho_hll = rho_hll + u_hll_c
1869 u_hll_c = (s_r*u_r(3) - s_l*u_l(3) - (f_r(3) - f_l(3)))/(s_r - s_l + verysmall)
1870 u_n_hll_cons = u_hll_c/(rho_hll + verysmall)
1871 u_hll_c = (s_r*u_r(8) - s_l*u_l(8) - (f_r(8) - f_l(8)))/(s_r - s_l + verysmall)
1872 tau_nn_hll = u_hll_c/(rho_hll + verysmall)
1873 u_hll_c = (s_r*u_r(11) - s_l*u_l(11) - (f_r(11) - f_l(11)))/(s_r - s_l + verysmall)
1874 tau_qq_face_hll = u_hll_c/(rho_hll + verysmall)
1875 ! This branch implies S_L < 0 < S_R, so component 3 of F_HLL is the interior HLL flux
1876 f_hll_c = f_hll_flux(s_l, s_r, f_l(3), f_r(3), u_l(3), u_r(3))
1877 p_face_hll = f_hll_c - rho_hll*u_n_hll_cons*u_n_hll_cons + tau_nn_hll
1878 end if
1879 end if
1880
1881 ! Reorder F_HLLD for output: pass 1 (hat_L) -> flux_rs*, pass 2 (hat_R) -> flux_hatR_rs*
1882# 806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1883 if (ipass == 1) then
1884# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1885 if (p > 0 .and. .not. cyl_coord) then
1886 ! 3D Cartesian: 14-state -> physical indices
1887 flux_rsx_vf(j, k, l, 1) = f_hlld(1)
1888# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1889 flux_rsx_vf(j, k, l, 2) = f_hlld(2)
1890# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1891 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
1892# 812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1893 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
1894# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1895 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(5)
1896# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1897 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(6)
1898# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1899 flux_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(7)
1900# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1901 flux_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(8)
1902# 817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1903 ! Map local stress to physical stress indices
1904 if (dir_idx(1) == 1) then
1905 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(9) ! tau_nn=tau_xx
1906# 820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1907 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
1908# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1909 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(12) ! tau_t1t1=tau_yy
1910# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1911 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(11) ! tau_nt2=tau_xz
1912# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1913 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(14) ! tau_t1t2=tau_yz
1914# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1915 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
1916# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1917 else if (dir_idx(1) == 2) then
1918 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
1919# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1920 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
1921# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1922 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(9) ! tau_nn=tau_yy
1923# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1924 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(14) ! tau_t1t2=tau_xz
1925# 830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1926 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
1927# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1928 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
1929# 832 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1930 else
1931 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
1932# 834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1933 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(14) ! tau_t1t2=tau_xy
1934# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1935 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(13) ! tau_t2t2=tau_yy
1936# 836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1937 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(10) ! tau_nt1=tau_xz
1938# 837 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1939 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
1940# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1941 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(9) ! tau_nn=tau_zz
1942# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1943 end if
1944 else
1945 ! 2D/axisym: 11-state (unchanged)
1946 flux_rsx_vf(j, k, l, 1) = f_hlld(1)
1947# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1948 flux_rsx_vf(j, k, l, 2) = f_hlld(2)
1949# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1950 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
1951# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1952 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
1953# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1954 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(5)
1955# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1956 flux_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(6)
1957# 848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1958 flux_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(7)
1959# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1960 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(9)
1961# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1962 if (dir_idx(1) == 1) then
1963 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(8)
1964# 852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1965 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(10)
1966# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1967 else
1968 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(10)
1969# 855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1970 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(8)
1971# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1972 end if
1973 if (cyl_coord) then
1974 flux_rsx_vf(j, k, l, eqn_idx%stress%end) = f_hlld(11)
1975# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1976 end if
1977 end if
1978 end if
1979# 806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1980 if (ipass == 2) then
1981# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1982 if (p > 0 .and. .not. cyl_coord) then
1983 ! 3D Cartesian: 14-state -> physical indices
1984 flux_hatr_rsx_vf(j, k, l, 1) = f_hlld(1)
1985# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1986 flux_hatr_rsx_vf(j, k, l, 2) = f_hlld(2)
1987# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1988 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
1989# 812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1990 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
1991# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1992 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(5)
1993# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1994 flux_hatr_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(6)
1995# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1996 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(7)
1997# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
1998 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(8)
1999# 817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2000 ! Map local stress to physical stress indices
2001 if (dir_idx(1) == 1) then
2002 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(9) ! tau_nn=tau_xx
2003# 820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2004 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
2005# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2006 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(12) ! tau_t1t1=tau_yy
2007# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2008 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(11) ! tau_nt2=tau_xz
2009# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2010 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(14) ! tau_t1t2=tau_yz
2011# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2012 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
2013# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2014 else if (dir_idx(1) == 2) then
2015 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
2016# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2017 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
2018# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2019 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(9) ! tau_nn=tau_yy
2020# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2021 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(14) ! tau_t1t2=tau_xz
2022# 830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2023 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
2024# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2025 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
2026# 832 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2027 else
2028 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
2029# 834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2030 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(14) ! tau_t1t2=tau_xy
2031# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2032 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(13) ! tau_t2t2=tau_yy
2033# 836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2034 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(10) ! tau_nt1=tau_xz
2035# 837 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2036 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
2037# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2038 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(9) ! tau_nn=tau_zz
2039# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2040 end if
2041 else
2042 ! 2D/axisym: 11-state (unchanged)
2043 flux_hatr_rsx_vf(j, k, l, 1) = f_hlld(1)
2044# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2045 flux_hatr_rsx_vf(j, k, l, 2) = f_hlld(2)
2046# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2047 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
2048# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2049 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
2050# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2051 flux_hatr_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(5)
2052# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2053 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(6)
2054# 848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2055 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(7)
2056# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2057 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(9)
2058# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2059 if (dir_idx(1) == 1) then
2060 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(8)
2061# 852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2062 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(10)
2063# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2064 else
2065 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(10)
2066# 855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2067 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(8)
2068# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2069 end if
2070 if (cyl_coord) then
2071 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%end) = f_hlld(11)
2072# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2073 end if
2074 end if
2075 end if
2076# 863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2077
2078 ! Export face velocities for axisym hypo source terms
2079 if (grid_geometry == 2) then
2080 if (fan_fallback) then
2081 ! Fallback face: the conservative flux is the HLL/one-sided flux, so export the
2082 ! matching HLL/one-sided traces, not the rejected fan's contact speed/star states
2083 u_n_face = u_n_hll_trace; u_t_face = u_t_hll_trace
2084 else
2085 ! Upwind by wave-fan wedge: the inner zones ride the contact (u_n = S_M) and the
2086 ! tangential state switches L -> star -> R across the shear waves (zones 2 and 3
2087 ! share the tangential star state)
2088 if (zone == 0) then
2089 u_n_face = u_n_l; u_t_face = u_t_l
2090 else if (zone == 1) then
2091 u_n_face = s_m; u_t_face = u_t_l
2092 else if (zone <= 3) then
2093 u_n_face = s_m; u_t_face = u_t_star
2094 else if (zone == 4) then
2095 u_n_face = s_m; u_t_face = u_t_r
2096 else
2097 u_n_face = u_n_r; u_t_face = u_t_r
2098 end if
2099 ! ADC blend NC face velocities with HLL scalar traces (valid fans; a fallback
2100 ! face already exports the pure HLL traces)
2101 if (riemann_hypo_adc) then
2102 u_n_face = u_n_hll_trace + phi*(u_n_face - u_n_hll_trace)
2103 u_t_face = u_t_hll_trace + phi*(u_t_face - u_t_hll_trace)
2104 end if
2105 end if
2106# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2107 if (ipass == 1) then
2108# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2109 if (dir_idx(1) == 1) then
2110 nc_iface_vel_rsx_vf(j, k, l, 1) = u_n_face
2111# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2112 nc_iface_vel_rsx_vf(j, k, l, 2) = u_t_face
2113# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2114 else
2115 nc_iface_vel_rsx_vf(j, k, l, 1) = u_t_face
2116# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2117 nc_iface_vel_rsx_vf(j, k, l, 2) = u_n_face
2118# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2119 end if
2120 end if
2121# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2122 if (ipass == 2) then
2123# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2124 if (dir_idx(1) == 1) then
2125 nc_iface_vel_hatr_rsx_vf(j, k, l, 1) = u_n_face
2126# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2127 nc_iface_vel_hatr_rsx_vf(j, k, l, 2) = u_t_face
2128# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2129 else
2130 nc_iface_vel_hatr_rsx_vf(j, k, l, 1) = u_t_face
2131# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2132 nc_iface_vel_hatr_rsx_vf(j, k, l, 2) = u_n_face
2133# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2134 end if
2135 end if
2136# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2137 end if
2138
2139 ! Radial geometric source flux for cylindrical coordinates. Only genuinely conservative rows
2140 ! (masses, momenta, energy) carry a numerical geometric flux: their full radial flux IS the
2141 ! -H/r metric quantity. The volume-fraction and stress rows are zeroed: the augmented stress
2142 ! fluxes fold constitutive velocity terms that must not be divided by r; their complete
2143 ! cylindrical completion is the cell-local dual-pass source
2144 ! (s_compute_hypoelastic_rhs_axisym_geom_dual_pass).
2145# 954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2146 end do
2147
2148 ! Dual-pass HLLD: all NC terms stay inside the Riemann flux (anchor-independent; written once)
2149 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
2150# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2151 end do
2152 end do
2153 end do
2154
2155# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2156#if defined(MFC_OpenACC)
2157# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2158!$acc end parallel loop
2159# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2160#elif defined(MFC_OpenMP)
2161# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2162
2163# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2164!$omp end target teams loop
2165# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2166#endif
2167# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2168 end if
2169# 178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2170# 179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2171# 180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2172 if (norm_dir == 2) then
2173# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2174 ! Anchor-cell index pattern: the fused kernel reads both anchors (hat_L: face cell, hat_R: face cell + 1)
2175 ! directly from q_prim_vf; loop indices are physical, so the offset rides the stencil index.
2176# 184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2177 ! The fused HLLD kernel privatizes ~150 scalars -- a private() list large enough that
2178 ! the single clause must be wrapped across continuation lines. The four fragments
2179 ! (_hlld_p1..p4) are ONLY for source readability; fypp concatenates them into one
2180 ! clause below. That wrapping is FOLD_DIRECTIVE's job -- its within-clause comma split
2181 ! exists for exactly this case -- not the fragments'.
2182# 190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2183# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2184# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2185# 193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2186 ! Wave-fan side table for the per-component F_hlld fold below: side name, the side's two zones,
2187 ! its starstar zone, and the outer/inner wave speeds. The L and R sides are mirror images.
2188# 196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2189 ! Wave-fan component tables for the per-component fold below: (us, uss) expression pairs in
2190 ! F_hlld component order; uss = None means the inner (starstar) correction leaves the
2191 ! component unchanged (uss_c = us_c). '{S}' expands to the fan side (L/R).
2192# 213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2193# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2194
2195# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2196
2197# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2198#if defined(MFC_OpenACC)
2199# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2200!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, ipass, degenerate, shear_degenerate, fan_fallback, shear_cond, alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, &
2201# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2202!$acc& pres, E, gamma, pi_inf, qv, vel_rms, c, S_L, S_R, s_M, S_Lstar, S_Rstar, pTot_L, pTot_R, rhoL_star, rhoR_star, U_L, U_R, F_L, F_R, F_hlld, us_c, uss_c, zone, F_HLL_c, U_HLL_c, rho_HLL, &
2203# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2204!$acc& u_n_HLL_cons, tau_nn_HLL, u_n_HLL_trace, u_t_HLL_trace, p_face_HLL, tau_qq_face_HLL, ncomp, G_eff, G_eff_tol, C_NC, sqrtC_NC, A_L, A_R, denomA, fac_L, fac_R, u_n_L, u_t_L, u_n_R, u_t_R, u_t2_L, &
2205# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2206!$acc& u_t2_R, tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R, tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, G_L, G_R, tau_e_L, tau_e_R, &
2207# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2208!$acc& alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star, u_t_star, tau_nt_star, u_t2_star, tau_nt2_star, tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star, tau_tt_L_starstar, &
2209# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2210!$acc& tau_tt_R_starstar, tau_t2t2_L_star, tau_t2t2_R_star, tau_t2t2_L_starstar, tau_t2t2_R_starstar, tau_t1t2_L_star, tau_t1t2_R_star, tau_t1t2_L_starstar, tau_t1t2_R_starstar, tau_qq_L_star, &
2211# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2212!$acc& tau_qq_R_star, pTot_star, E_L_star, E_R_star, E_L_starstar, E_R_starstar, p_face, tau_qq_face, u_n_face, u_t_face, G_hat, rho_hat, tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat, tau_nt2_hat, &
2213# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2214!$acc& tau_t2t2_hat, tau_t1t2_hat, alpha_hat, alpha_rho_hat, tau_e_hat, pres_hat, blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q, C_hat_1, C_hat_2, Sigma_L, Sigma_R, dSigma, Sigma_ref, &
2215# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2216!$acc& a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, phi, alpha_L_sum, alpha_R_sum)
2217# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2218#elif defined(MFC_OpenMP)
2219# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2220
2221# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2222
2223# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2224
2225# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2226!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, &
2227# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2228!$omp& ipass, degenerate, shear_degenerate, fan_fallback, shear_cond, alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, gamma, pi_inf, qv, vel_rms, c, S_L, S_R, s_M, S_Lstar, S_Rstar, &
2229# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2230!$omp& pTot_L, pTot_R, rhoL_star, rhoR_star, U_L, U_R, F_L, F_R, F_hlld, us_c, uss_c, zone, F_HLL_c, U_HLL_c, rho_HLL, u_n_HLL_cons, tau_nn_HLL, u_n_HLL_trace, u_t_HLL_trace, p_face_HLL, &
2231# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2232!$omp& tau_qq_face_HLL, ncomp, G_eff, G_eff_tol, C_NC, sqrtC_NC, A_L, A_R, denomA, fac_L, fac_R, u_n_L, u_t_L, u_n_R, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R, &
2233# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2234!$omp& tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, G_L, G_R, tau_e_L, tau_e_R, alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star, u_t_star, &
2235# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2236!$omp& tau_nt_star, u_t2_star, tau_nt2_star, tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star, tau_tt_L_starstar, tau_tt_R_starstar, tau_t2t2_L_star, tau_t2t2_R_star, tau_t2t2_L_starstar, &
2237# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2238!$omp& tau_t2t2_R_starstar, tau_t1t2_L_star, tau_t1t2_R_star, tau_t1t2_L_starstar, tau_t1t2_R_starstar, tau_qq_L_star, tau_qq_R_star, pTot_star, E_L_star, E_R_star, E_L_starstar, E_R_starstar, p_face, &
2239# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2240!$omp& tau_qq_face, u_n_face, u_t_face, G_hat, rho_hat, tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat, tau_nt2_hat, tau_t2t2_hat, tau_t1t2_hat, alpha_hat, alpha_rho_hat, tau_e_hat, pres_hat, &
2241# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2242!$omp& blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q, C_hat_1, C_hat_2, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, &
2243# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2244!$omp& sensor_vt, sensor_tnt, sensor_combined, phi, alpha_L_sum, alpha_R_sum)
2245# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2246#endif
2247# 225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2248 do l = is3%beg, is3%end
2249# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2250 do k = is1%beg, is1%end
2251# 227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2252 do j = is2%beg, is2%end
2253# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2254 ! Extract left/right primitive states
2255
2256 do i = 1, eqn_idx%cont%end
2257 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2258# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2259 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
2260# 233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2261 end do
2262
2263 ! Initialize the unused third velocity component in 2D
2264 vel%L = 0._wp
2265 vel%R = 0._wp
2266
2267 ! Load velocities in physical-coordinate order; map directional aliases below via dir_idx
2268 do i = 1, num_vels
2269 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2270# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2271 vel%R(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
2272# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2273 end do
2274
2275 vel_rms%L = vel%L(1)**2 + vel%L(2)**2 + vel%L(3)**2
2276 vel_rms%R = vel%R(1)**2 + vel%R(2)**2 + vel%R(3)**2
2277
2278 do i = 1, num_fluids
2279 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2280# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2281 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
2282# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2283 end do
2284
2285 ! Clamp and renormalize volume fractions when mpp_lim is on (match HLL/HLLC)
2286 alpha_l_sum = 0._wp
2287 alpha_r_sum = 0._wp
2288 if (mpp_lim) then
2289 do i = 1, num_fluids
2290 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
2291 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2292 alpha_l_sum = alpha_l_sum + alpha_l(i)
2293 end do
2294 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2295
2296 do i = 1, num_fluids
2297 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2298 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2299 alpha_r_sum = alpha_r_sum + alpha_r(i)
2300 end do
2301 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2302 end if
2303
2304 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2305# 273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2306 pres%R = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
2307# 274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2308
2309 ! Hypoelasticity
2310
2311# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2312#if defined(MFC_OpenACC)
2313# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2314!$acc loop seq
2315# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2316#elif defined(MFC_OpenMP)
2317# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2318
2319# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2320#endif
2321# 277 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2322 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2323 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2324# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2325 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
2326# 280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2327 end do
2328
2329 u_t2_l = 0._wp; u_t2_r = 0._wp
2330 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
2331 tau_t2t2_l = 0._wp; tau_t2t2_r = 0._wp
2332 tau_t1t2_l = 0._wp; tau_t1t2_r = 0._wp
2333
2334 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
2335 u_n_l = vel%L(dir_idx(1)); u_n_r = vel%R(dir_idx(1))
2336 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
2337 if (n == 0) then
2338 ncomp = 11
2339 else if (p == 0) then
2340 ncomp = 11
2341 u_t_l = vel%L(dir_idx(2)); u_t_r = vel%R(dir_idx(2))
2342 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
2343 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
2344 else
2345 ncomp = 14
2346 u_t_l = vel%L(dir_idx(2)); u_t_r = vel%R(dir_idx(2))
2347 u_t2_l = vel%L(dir_idx(3)); u_t2_r = vel%R(dir_idx(3))
2348 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
2349 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
2350 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
2351 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
2352 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
2353 end if
2354 if (cyl_coord) then
2355 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
2356 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
2357 else
2358 tau_qq_l = 0._wp; tau_qq_r = 0._wp
2359 end if
2360 ! Total pressure (replace the usual pressure to define SM)
2361 ptot_l = pres%L - tau_nn_l
2362 ptot_r = pres%R - tau_nn_r
2363
2364 ! Symmetrize total pressure when it differs only by floating-point roundoff. WENO reconstruction of a
2365 ! uniform field can produce slightly different L/R values at material interfaces due to different
2366 ! smoothness indicators. With stiff materials (G~1e9), even 1e-12 relative pTot asymmetry creates O(1)
2367 ! spurious stress through the HLLD star-state.
2368 if (abs(ptot_r - ptot_l) < 1e-12_wp*max(abs(ptot_l), abs(ptot_r), 1._wp)) then
2369 ptot_l = 5e-1_wp*(ptot_l + ptot_r)
2370 ptot_r = ptot_l
2371 end if
2372
2373 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho%L, gamma%L, pi_inf%L, qv%L)
2374 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho%R, gamma%R, pi_inf%R, qv%R)
2375
2376 g_l = 0._wp; g_r = 0._wp
2377
2378# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2379#if defined(MFC_OpenACC)
2380# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2381!$acc loop seq
2382# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2383#elif defined(MFC_OpenMP)
2384# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2385
2386# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2387#endif
2388# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2389 do i = 1, num_fluids
2390 g_l = g_l + alpha_l(i)*gs_rs(i)
2391 g_r = g_r + alpha_r(i)*gs_rs(i)
2392 end do
2393
2394 call s_compute_energy(pres%L, alpha_rho_l, alpha_l, vel_rms%L, e%L)
2395 call s_compute_energy(pres%R, alpha_rho_r, alpha_r, vel_rms%R, e%R)
2396
2397 ! Freeze the thermal/kinetic enthalpy used by the EOS sound-speed call before
2398 ! adding hypoelastic strain energy to the conservative total energy.
2399
2400
2401# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2402#if defined(MFC_OpenACC)
2403# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2404!$acc loop seq
2405# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2406#elif defined(MFC_OpenMP)
2407# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2408
2409# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2410#endif
2411# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2412 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2413 shear_cond = (n > 0 .and. p == 0 .and. i == 2) .or. (p > 0 .and. (i == 2 .or. i == 4 .or. i == 5))
2414 e%L = e%L + f_elastic_energy(tau_e_l(i), g_l, shear_cond)
2415 e%R = e%R + f_elastic_energy(tau_e_r(i), g_r, shear_cond)
2416 end do
2417
2418 ! Compute Riemann states
2419
2420 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, alpha_l, c%L, alpha_rho_l)
2421 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, alpha_r, c%R, alpha_rho_r)
2422
2423 s_l = min(u_n_l - sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L)), &
2424 & u_n_r - sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R)))
2425 s_r = max(u_n_r + sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R)), &
2426 & u_n_l + sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L)))
2427
2428 if (p > 0 .and. .not. cyl_coord) then
2429 ! 3D Cartesian: 14-state compact basis
2430 u_l(1) = alpha_rho_l(1); u_r(1) = alpha_rho_r(1)
2431 u_l(2) = alpha_rho_l(2); u_r(2) = alpha_rho_r(2)
2432 u_l(3) = rho%L*u_n_l; u_r(3) = rho%R*u_n_r
2433 u_l(4) = rho%L*u_t_l; u_r(4) = rho%R*u_t_r
2434 u_l(5) = rho%L*u_t2_l; u_r(5) = rho%R*u_t2_r
2435 u_l(6) = e%L; u_r(6) = e%R
2436 u_l(7) = alpha_l(1); u_r(7) = alpha_r(1)
2437 u_l(8) = alpha_l(2); u_r(8) = alpha_r(2)
2438 u_l(9) = rho%L*tau_nn_l; u_r(9) = rho%R*tau_nn_r
2439 u_l(10) = rho%L*tau_nt_l; u_r(10) = rho%R*tau_nt_r
2440 u_l(11) = rho%L*tau_nt2_l; u_r(11) = rho%R*tau_nt2_r
2441 u_l(12) = rho%L*tau_tt_l; u_r(12) = rho%R*tau_tt_r
2442 u_l(13) = rho%L*tau_t2t2_l; u_r(13) = rho%R*tau_t2t2_r
2443 u_l(14) = rho%L*tau_t1t2_l; u_r(14) = rho%R*tau_t1t2_r
2444
2445 f_l(1) = u_l(1)*u_n_l; f_r(1) = u_r(1)*u_n_r
2446 f_l(2) = u_l(2)*u_n_l; f_r(2) = u_r(2)*u_n_r
2447 f_l(3) = rho%L*u_n_l*u_n_l + ptot_l
2448 f_r(3) = rho%R*u_n_r*u_n_r + ptot_r
2449 f_l(4) = rho%L*u_n_l*u_t_l - tau_nt_l
2450 f_r(4) = rho%R*u_n_r*u_t_r - tau_nt_r
2451 f_l(5) = rho%L*u_n_l*u_t2_l - tau_nt2_l
2452 f_r(5) = rho%R*u_n_r*u_t2_r - tau_nt2_r
2453 f_l(6) = (e%L + ptot_l)*u_n_l - u_t_l*tau_nt_l - u_t2_l*tau_nt2_l
2454 f_r(6) = (e%R + ptot_r)*u_n_r - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r
2455 ! Rows 7-14 (volume fractions + stresses) carry the anchor-dependent hat coefficients and are filled
2456 ! inside the per-anchor pass loop below.
2457 else
2458 ! 2D/axisym: 11-state compact basis (unchanged)
2459 u_l(1) = alpha_rho_l(1)
2460 u_l(2) = alpha_rho_l(2)
2461 u_l(3) = rho%L*u_n_l
2462 u_l(4) = rho%L*u_t_l
2463 u_l(5) = e%L
2464 u_l(6) = alpha_l(1)
2465 u_l(7) = alpha_l(2)
2466 u_l(8) = rho%L*tau_nn_l
2467 u_l(9) = rho%L*tau_nt_l
2468 u_l(10) = rho%L*tau_tt_l
2469 u_l(11) = rho%L*tau_qq_l
2470
2471 u_r(1) = alpha_rho_r(1)
2472 u_r(2) = alpha_rho_r(2)
2473 u_r(3) = rho%R*u_n_r
2474 u_r(4) = rho%R*u_t_r
2475 u_r(5) = e%R
2476 u_r(6) = alpha_r(1)
2477 u_r(7) = alpha_r(2)
2478 u_r(8) = rho%R*tau_nn_r
2479 u_r(9) = rho%R*tau_nt_r
2480 u_r(10) = rho%R*tau_tt_r
2481 u_r(11) = rho%R*tau_qq_r
2482
2483 f_l(1) = u_l(1)*u_n_l
2484 f_l(2) = u_l(2)*u_n_l
2485 f_l(3) = rho%L*u_n_l*u_n_l + ptot_l
2486 f_l(4) = rho%L*u_n_l*u_t_l - tau_nt_l
2487 f_l(5) = (e%L + ptot_l)*u_n_l - u_t_l*tau_nt_l
2488
2489 f_r(1) = u_r(1)*u_n_r
2490 f_r(2) = u_r(2)*u_n_r
2491 f_r(3) = rho%R*u_n_r*u_n_r + ptot_r
2492 f_r(4) = rho%R*u_n_r*u_t_r - tau_nt_r
2493 f_r(5) = (e%R + ptot_r)*u_n_r - u_t_r*tau_nt_r
2494 ! Rows 6-11 (volume fractions + stresses) carry the anchor-dependent hat coefficients and are filled
2495 ! inside the per-anchor pass loop below.
2496 end if
2497
2498 a_l = rho%L*(s_l - u_n_l)
2499 a_r = rho%R*(s_r - u_n_r)
2500 denoma = (a_r - a_l)
2501
2502 s_m = ((ptot_r - ptot_l) + a_l*u_n_l - a_r*u_n_r)/(a_l - a_r + verysmall)
2503
2504 ! Degenerate wave structure: denom ~ 0 or S_M not in [S_L,S_R]. The test is anchor-independent, so both
2505 ! anchored solves below take the same branch.
2506 degenerate = (abs(denoma) < verysmall .or. .not. (s_l - verysmall <= s_m .and. s_m <= s_r + verysmall))
2507
2508 if (.not. degenerate) then
2509 ! Anchor-independent pieces of the star region (the anchor state enters only the volume-fraction and
2510 ! stress star states)
2511 ptot_star = ptot_l + a_l*(s_m - u_n_l)
2512
2513 ! Signed floor (HLLC-style, see m_riemann_solver_hllc.fpp) on the wave-fan denominators: guards the
2514 ! degenerate S_M -> S_L / S_M -> S_R limit, sign-preserving, and a no-op away from it (|denom| >>
2515 ! verysmall)
2516 rhol_star = rho%L*(s_l - u_n_l)/min(s_l - s_m, -verysmall)
2517 rhor_star = rho%R*(s_r - u_n_r)/max(s_r - s_m, verysmall)
2518 fac_l = (s_l - u_n_l)/min(s_l - s_m, -verysmall)
2519 fac_r = (s_r - u_n_r)/max(s_r - s_m, verysmall)
2520
2521 e_l_star = (e%L*(u_n_l - s_l) + u_n_l*ptot_l - s_m*ptot_star)/max(s_m - s_l, verysmall)
2522 e_r_star = (e%R*(u_n_r - s_r) + u_n_r*ptot_r - s_m*ptot_star)/min(s_m - s_r, -verysmall)
2523
2524 if (riemann_hypo_adc) then
2525 ! ADC sensors depend only on the L/R face states: computed once, shared by both anchored solves
2526 sigma_l = ptot_l
2527 sigma_r = ptot_r
2528 dsigma = sigma_r - sigma_l
2529 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
2530
2531 a_l_ref = sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L))
2532 a_r_ref = sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R))
2533 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
2534
2535 du_t = u_t_r - u_t_l
2536 dtau_nt = tau_nt_r - tau_nt_l
2537 du_t2 = u_t2_r - u_t2_l
2538 dtau_nt2 = tau_nt2_r - tau_nt2_l
2539
2540 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
2541 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
2542 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 + verysmall)
2543
2544 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
2545
2546 phi = exp(-(sensor_combined**adc_power))
2547 end if
2548 end if
2549
2550 ! Fused dual-pass: both anchored solves share everything above. The anchor (hat) state and everything it
2551 ! touches is evaluated per pass: pass 1 anchors on cell j (hat_L) and writes the flux_rs* set; pass 2
2552 ! anchors on cell j+1 (hat_R) and writes the flux_hatR_rs* set.
2553
2554# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2555#if defined(MFC_OpenACC)
2556# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2557!$acc loop seq
2558# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2559#elif defined(MFC_OpenMP)
2560# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2561
2562# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2563#endif
2564# 485 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2565 do ipass = 1, 2
2566 do i = 1, eqn_idx%cont%end
2567 alpha_rho_hat(i) = q_prim_vf(i)%sf(j, k + ipass - 1, l)
2568# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2569 end do
2570 do i = 1, num_fluids
2571 alpha_hat(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k + ipass - 1, l)
2572# 491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2573 end do
2574
2575# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2576#if defined(MFC_OpenACC)
2577# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2578!$acc loop seq
2579# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2580#elif defined(MFC_OpenMP)
2581# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2582
2583# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2584#endif
2585# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2586 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2587 tau_e_hat(i) = q_prim_vf(eqn_idx%stress%beg - 1 + i)%sf(j, k + ipass - 1, l)
2588# 495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2589 end do
2590
2591 ! Anchor-state directional aliases (mirrors the L/R alias block above)
2592 tau_nt2_hat = 0._wp; tau_t2t2_hat = 0._wp; tau_t1t2_hat = 0._wp
2593 tau_nn_hat = tau_e_hat(stress_perm(1))
2594 if (n > 0) then
2595 tau_nt_hat = tau_e_hat(stress_perm(2))
2596 tau_tt_hat = tau_e_hat(stress_perm(3))
2597 if (p > 0) then
2598 tau_nt2_hat = tau_e_hat(stress_perm(4))
2599 tau_t1t2_hat = tau_e_hat(stress_perm(5))
2600 tau_t2t2_hat = tau_e_hat(stress_perm(6))
2601 end if
2602 end if
2603 if (cyl_coord) then
2604 tau_qq_hat = tau_e_hat(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
2605 else
2606 tau_qq_hat = 0._wp
2607 end if
2608
2609 rho_hat = 0._wp
2610
2611# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2612#if defined(MFC_OpenACC)
2613# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2614!$acc loop seq
2615# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2616#elif defined(MFC_OpenMP)
2617# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2618
2619# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2620#endif
2621# 517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2622 do i = 1, num_fluids
2623 rho_hat = rho_hat + alpha_rho_hat(i)
2624 end do
2625
2626 g_hat = 0._wp
2627
2628# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2629#if defined(MFC_OpenACC)
2630# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2631!$acc loop seq
2632# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2633#elif defined(MFC_OpenMP)
2634# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2635
2636# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2637#endif
2638# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2639 do i = 1, num_fluids
2640 g_hat = g_hat + alpha_hat(i)*gs_rs(i)
2641 end do
2642
2643 ! Two-component 2D only (enforced by checker restrictions)
2644 k_hat = 0._wp
2645 if (alt_soundspeed) then
2646 pres_hat = q_prim_vf(eqn_idx%E)%sf(j, k + ipass - 1, l)
2647# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2648 alpha_hat_q = alpha_hat(1)
2649 alpha_rho_hat_q = alpha_rho_hat(1)
2650 call s_phase_bulk_modulus(pres_hat, alpha_hat_q, alpha_rho_hat_q, 1, blkmod1_hat)
2651 alpha_hat_q = alpha_hat(2)
2652 alpha_rho_hat_q = alpha_rho_hat(2)
2653 call s_phase_bulk_modulus(pres_hat, alpha_hat_q, alpha_rho_hat_q, 2, blkmod2_hat)
2654 blkmod1_hat = blkmod1_hat + (4._wp/3._wp)*gs_rs(1)
2655 blkmod2_hat = blkmod2_hat + (4._wp/3._wp)*gs_rs(2)
2656 k_hat = alpha_hat(1)*alpha_hat(2)*(blkmod2_hat - blkmod1_hat)/(alpha_hat(1)*blkmod2_hat &
2657 & + alpha_hat(2)*blkmod1_hat + verysmall)
2658 end if
2659 c_hat_1 = alpha_hat(1) + k_hat
2660 c_hat_2 = alpha_hat(2) - k_hat
2661
2662 if (p > 0 .and. .not. cyl_coord) then
2663 ! 3D Cartesian: anchor-dependent rows (7-14) of the 14-state flux
2664 f_l(7) = u_l(7)*u_n_l - c_hat_1*u_n_l
2665 f_r(7) = u_r(7)*u_n_r - c_hat_1*u_n_r
2666 f_l(8) = u_l(8)*u_n_l - c_hat_2*u_n_l
2667 f_r(8) = u_r(8)*u_n_r - c_hat_2*u_n_r
2668 f_l(9) = u_l(9)*u_n_l - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_l
2669 f_r(9) = u_r(9)*u_n_r - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_r
2670 f_l(10) = u_l(10)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t_l
2671 f_r(10) = u_r(10)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t_r
2672 f_l(11) = u_l(11)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t2_l
2673 f_r(11) = u_r(11)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t2_r
2674 f_l(12) = u_l(12)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_l &
2675 & - 2._wp*rho_hat*tau_nt_hat*u_t_l
2676 f_r(12) = u_r(12)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_r &
2677 & - 2._wp*rho_hat*tau_nt_hat*u_t_r
2678 f_l(13) = u_l(13)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_t2t2_hat)*u_n_l &
2679 & - 2._wp*rho_hat*tau_nt2_hat*u_t2_l
2680 f_r(13) = u_r(13)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_t2t2_hat)*u_n_r &
2681 & - 2._wp*rho_hat*tau_nt2_hat*u_t2_r
2682 f_l(14) = u_l(14)*u_n_l + rho_hat*tau_t1t2_hat*u_n_l - rho_hat*tau_nt2_hat*u_t_l &
2683 & - rho_hat*tau_nt_hat*u_t2_l
2684 f_r(14) = u_r(14)*u_n_r + rho_hat*tau_t1t2_hat*u_n_r - rho_hat*tau_nt2_hat*u_t_r &
2685 & - rho_hat*tau_nt_hat*u_t2_r
2686 else
2687 ! 2D/axisym: anchor-dependent rows (6-11) of the 11-state flux
2688 f_l(6) = u_l(6)*u_n_l - c_hat_1*u_n_l
2689 f_r(6) = u_r(6)*u_n_r - c_hat_1*u_n_r
2690 f_l(7) = u_l(7)*u_n_l - c_hat_2*u_n_l
2691 f_r(7) = u_r(7)*u_n_r - c_hat_2*u_n_r
2692 f_l(8) = u_l(8)*u_n_l - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_l
2693 f_r(8) = u_r(8)*u_n_r - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_r
2694 f_l(9) = u_l(9)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t_l
2695 f_r(9) = u_r(9)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t_r
2696 f_l(10) = u_l(10)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_l &
2697 & - 2._wp*rho_hat*tau_nt_hat*u_t_l
2698 f_r(10) = u_r(10)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_r &
2699 & - 2._wp*rho_hat*tau_nt_hat*u_t_r
2700 f_l(11) = u_l(11)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_qq_hat)*u_n_l
2701 f_r(11) = u_r(11)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_qq_hat)*u_n_r
2702 end if
2703
2704 ! The effective shear stiffness is anchor-dependent. Resolve its three numerical states before
2705 ! forming C_NC: positive keeps HLLD; zero to cancellation accuracy takes the finite HLLC limit;
2706 ! materially negative (loss of the assumed real shear subfan) rejects the whole anchored fan.
2707 ! The tolerance is relative only to the two terms being added, not to an acoustic/material scale.
2708 fan_fallback = degenerate
2709 shear_degenerate = .false.
2710 if (.not. fan_fallback) then
2711 g_eff = g_hat + tau_nn_hat
2712 g_eff_tol = g_eff_roundoff_factor*epsilon(1._wp)*(abs(g_hat) + abs(tau_nn_hat))
2713
2714 if (.not. (g_eff >= -g_eff_tol)) then
2715 ! Materially negative, or unordered (NaN): no real five-wave shear fan.
2716 fan_fallback = .true.
2717 else if (g_eff <= g_eff_tol) then
2718 shear_degenerate = .true.
2719 s_lstar = s_m
2720 s_rstar = s_m
2721 else
2722 c_nc = rho_hat*g_eff
2723 if (.not. (c_nc > 0._wp)) then
2724 ! Positive G_eff below the representable C_NC range is numerically degenerate;
2725 ! nonpositive/unordered rho_hat is invalid for the same construction.
2726 shear_degenerate = (rho_hat > 0._wp)
2727 fan_fallback = .not. shear_degenerate
2728 s_lstar = s_m
2729 s_rstar = s_m
2730 else
2731 sqrtc_nc = sqrt(c_nc)
2732 s_lstar = s_m - sqrtc_nc/rhol_star
2733 s_rstar = s_m + sqrtc_nc/rhor_star
2734 ! A speed-only clamp would break the corresponding Rankine--Hugoniot jump.
2735 fan_fallback = (s_lstar < s_l .or. s_rstar > s_r)
2736 end if
2737 end if
2738 end if
2739
2740 if (fan_fallback) then
2741 ! HLL (or one-sided) fallback for an invalid wave structure
2742 if (s_l < 0._wp .and. s_r > 0._wp) then
2743 do i = 1, ncomp
2744 f_hlld(i) = f_hll_flux(s_l, s_r, f_l(i), f_r(i), u_l(i), u_r(i))
2745 end do
2746 else if (s_l >= 0._wp) then
2747 f_hlld(1:ncomp) = f_l(1:ncomp)
2748 else
2749 f_hlld(1:ncomp) = f_r(1:ncomp)
2750 end if
2751 ! Initialize star-state variables to safe values so no path reads uninitialized memory
2752 ! (a subsequent valid pass restores what it needs). Fallback face exports do not use
2753 ! them: they take the HLL/one-sided traces computed below.
2754 ptot_star = 5e-1_wp*(ptot_l + ptot_r)
2755 s_lstar = s_l
2756 s_rstar = s_r
2757 u_t_star = 5e-1_wp*(u_t_l + u_t_r)
2758 tau_nn_l_star = tau_nn_l
2759 tau_nn_r_star = tau_nn_r
2760 tau_qq_l_star = tau_qq_l
2761 tau_qq_r_star = tau_qq_r
2762 else
2763 ! A preceding anchored pass may have taken the fallback and assigned a safe face value.
2764 ! Restore the anchor-independent HLLD contact pressure for this valid pass.
2765 ptot_star = ptot_l + a_l*(s_m - u_n_l)
2766
2767 if (shear_degenerate) then
2768 ! Degenerate shear impedance: collapse inner waves to HLLC
2769 u_t_star = 5e-1_wp*(u_t_l + u_t_r)
2770 tau_nt_star = 5e-1_wp*(tau_nt_l + tau_nt_r)
2771 u_t2_star = 5e-1_wp*(u_t2_l + u_t2_r)
2772 tau_nt2_star = 5e-1_wp*(tau_nt2_l + tau_nt2_r)
2773 else
2774 u_t_star = 5e-1_wp*((tau_nt_r - tau_nt_l)/sqrtc_nc + (u_t_r + u_t_l))
2775 tau_nt_star = 5e-1_wp*((u_t_r - u_t_l)*sqrtc_nc + (tau_nt_r + tau_nt_l))
2776 u_t2_star = 5e-1_wp*((tau_nt2_r - tau_nt2_l)/sqrtc_nc + (u_t2_r + u_t2_l))
2777 tau_nt2_star = 5e-1_wp*((u_t2_r - u_t2_l)*sqrtc_nc + (tau_nt2_r + tau_nt2_l))
2778 end if
2779
2780 ! Outer-wave stress star states: one formula family over the components. ELC is
2781 ! the anchor-side elastic coefficient (deviatoric 4/3 vs 2/3 structure; t1t2
2782 ! carries no G term) and SGN = -1/+1 the jump sign of the component.
2783# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2784# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2785 tau_nn_l_star = tau_nn_l - (rho_hat*(g_hat*4._wp/3._wp + tau_nn_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
2786# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2787# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2788 tau_nn_r_star = tau_nn_r - (rho_hat*(g_hat*4._wp/3._wp + tau_nn_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
2789# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2790# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2791# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2792# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2793 tau_tt_l_star = tau_tt_l + (rho_hat*(g_hat*2._wp/3._wp + tau_tt_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
2794# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2795# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2796 tau_tt_r_star = tau_tt_r + (rho_hat*(g_hat*2._wp/3._wp + tau_tt_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
2797# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2798# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2799# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2800# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2801 tau_t2t2_l_star = tau_t2t2_l + (rho_hat*(g_hat*2._wp/3._wp + tau_t2t2_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
2802# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2803# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2804 tau_t2t2_r_star = tau_t2t2_r + (rho_hat*(g_hat*2._wp/3._wp + tau_t2t2_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
2805# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2806# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2807# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2808# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2809 tau_t1t2_l_star = tau_t1t2_l + (rho_hat*tau_t1t2_hat*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
2810# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2811# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2812 tau_t1t2_r_star = tau_t1t2_r + (rho_hat*tau_t1t2_hat*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
2813# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2814# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2815# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2816# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2817 tau_qq_l_star = tau_qq_l + (rho_hat*(g_hat*2._wp/3._wp + tau_qq_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
2818# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2819# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2820 tau_qq_r_star = tau_qq_r + (rho_hat*(g_hat*2._wp/3._wp + tau_qq_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
2821# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2822# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2823# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2824
2825 if (shear_degenerate) then
2826 ! Degenerate: no inner wave correction
2827 tau_tt_l_starstar = tau_tt_l_star
2828 tau_tt_r_starstar = tau_tt_r_star
2829 tau_t2t2_l_starstar = tau_t2t2_l_star
2830 tau_t2t2_r_starstar = tau_t2t2_r_star
2831 tau_t1t2_l_starstar = tau_t1t2_l_star
2832 tau_t1t2_r_starstar = tau_t1t2_r_star
2833 e_l_starstar = e_l_star
2834 e_r_starstar = e_r_star
2835 else
2836 tau_tt_l_starstar = tau_tt_l_star + 2._wp*rho_hat*tau_nt_hat/sqrtc_nc*(u_t_star - u_t_l)
2837 tau_tt_r_starstar = tau_tt_r_star - 2._wp*rho_hat*tau_nt_hat/sqrtc_nc*(u_t_star - u_t_r)
2838 tau_t2t2_l_starstar = tau_t2t2_l_star + 2._wp*rho_hat*tau_nt2_hat/sqrtc_nc*(u_t2_star &
2839 & - u_t2_l)
2840 tau_t2t2_r_starstar = tau_t2t2_r_star - 2._wp*rho_hat*tau_nt2_hat/sqrtc_nc*(u_t2_star &
2841 & - u_t2_r)
2842 tau_t1t2_l_starstar = tau_t1t2_l_star + rho_hat*(tau_nt2_hat*(u_t_star - u_t_l) &
2843 & + tau_nt_hat*(u_t2_star - u_t2_l))/sqrtc_nc
2844 tau_t1t2_r_starstar = tau_t1t2_r_star - rho_hat*(tau_nt2_hat*(u_t_star - u_t_r) &
2845 & + tau_nt_hat*(u_t2_star - u_t2_r))/sqrtc_nc
2846 e_l_starstar = e_l_star + (rhol_star/sqrtc_nc)*((u_t_star*tau_nt_star - u_t_l*tau_nt_l) &
2847 & + (u_t2_star*tau_nt2_star - u_t2_l*tau_nt2_l))
2848 e_r_starstar = e_r_star - (rhor_star/sqrtc_nc)*((u_t_star*tau_nt_star - u_t_r*tau_nt_r) &
2849 & + (u_t2_star*tau_nt2_star - u_t2_r*tau_nt2_r))
2850 end if
2851
2852 alpha1_l_star = (alpha_l(1)*(s_l - u_n_l) - c_hat_1*(s_m - u_n_l))/min(s_l - s_m, -verysmall)
2853 alpha1_r_star = (alpha_r(1)*(s_r - u_n_r) - c_hat_1*(s_m - u_n_r))/max(s_r - s_m, verysmall)
2854
2855 alpha2_l_star = (alpha_l(2)*(s_l - u_n_l) - c_hat_2*(s_m - u_n_l))/min(s_l - s_m, -verysmall)
2856 alpha2_r_star = (alpha_r(2)*(s_r - u_n_r) - c_hat_2*(s_m - u_n_r))/max(s_r - s_m, verysmall)
2857
2858 ! HLLD flux, register-diet form: pick the wave-fan zone once (it is
2859 ! component-independent), then fold the selected side's star/starstar states into
2860 ! F_hlld one component at a time through the scalars us_c/uss_c (no fan arrays
2861 ! survive). The L and R sides are mirror images and the per-component statements
2862 ! share one shape, so the whole fold is emitted from one Fypp template driven by
2863 ! HLLD_FAN_SIDES and the HLLD_FAN_COMPS_3D/2D tables above. Per-component operation
2864 ! order matches the materialized form, so the flux is -O0 bit-identical. Do NOT
2865 ! re-expand into per-region temp arrays (or reorder the fold) without re-checking
2866 ! GPU register spill and the -O0 exactness gate.
2867
2868 zone = f_hlld_wave_zone(s_l, s_lstar, s_m, s_rstar, s_r)
2869
2870 if (zone == 0) then
2871 f_hlld(1:ncomp) = f_l(1:ncomp)
2872 else if (zone == 5) then
2873 f_hlld(1:ncomp) = f_r(1:ncomp)
2874# 726 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2875 else if (zone == 1 .or. zone == 2) then
2876# 727 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2877 ! L side of the fan: per component, us_c/uss_c are the selected side's
2878# 728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2879 ! star/starstar states (the old F_starL is folded into the first F_hlld
2880# 729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2881 ! statement; the starstar correction applies in zone 2 only, with the
2882# 730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2883 ! left-associative order of the materialized form preserved)
2884 if (p > 0 .and. .not. cyl_coord) then
2885# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2886 us_c = u_l(1)*fac_l
2887# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2888 uss_c = us_c
2889# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2890 f_hlld(1) = f_l(1) + s_l*(us_c - u_l(1))
2891# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2892 if (zone == 2) f_hlld(1) = f_hlld(1) + s_lstar*(uss_c &
2893# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2894 & - us_c)
2895# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2896 us_c = u_l(2)*fac_l
2897# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2898 uss_c = us_c
2899# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2900 f_hlld(2) = f_l(2) + s_l*(us_c - u_l(2))
2901# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2902 if (zone == 2) f_hlld(2) = f_hlld(2) + s_lstar*(uss_c &
2903# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2904 & - us_c)
2905# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2906 us_c = rhol_star*s_m
2907# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2908 uss_c = us_c
2909# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2910 f_hlld(3) = f_l(3) + s_l*(us_c - u_l(3))
2911# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2912 if (zone == 2) f_hlld(3) = f_hlld(3) + s_lstar*(uss_c &
2913# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2914 & - us_c)
2915# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2916 us_c = rhol_star*u_t_l
2917# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2918 uss_c = rhol_star*u_t_star
2919# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2920 f_hlld(4) = f_l(4) + s_l*(us_c - u_l(4))
2921# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2922 if (zone == 2) f_hlld(4) = f_hlld(4) + s_lstar*(uss_c &
2923# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2924 & - us_c)
2925# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2926 us_c = rhol_star*u_t2_l
2927# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2928 uss_c = rhol_star*u_t2_star
2929# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2930 f_hlld(5) = f_l(5) + s_l*(us_c - u_l(5))
2931# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2932 if (zone == 2) f_hlld(5) = f_hlld(5) + s_lstar*(uss_c &
2933# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2934 & - us_c)
2935# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2936 us_c = e_l_star
2937# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2938 uss_c = e_l_starstar
2939# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2940 f_hlld(6) = f_l(6) + s_l*(us_c - u_l(6))
2941# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2942 if (zone == 2) f_hlld(6) = f_hlld(6) + s_lstar*(uss_c &
2943# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2944 & - us_c)
2945# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2946 us_c = alpha1_l_star
2947# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2948 uss_c = us_c
2949# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2950 f_hlld(7) = f_l(7) + s_l*(us_c - u_l(7))
2951# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2952 if (zone == 2) f_hlld(7) = f_hlld(7) + s_lstar*(uss_c &
2953# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2954 & - us_c)
2955# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2956 us_c = alpha2_l_star
2957# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2958 uss_c = us_c
2959# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2960 f_hlld(8) = f_l(8) + s_l*(us_c - u_l(8))
2961# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2962 if (zone == 2) f_hlld(8) = f_hlld(8) + s_lstar*(uss_c &
2963# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2964 & - us_c)
2965# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2966 us_c = rhol_star*tau_nn_l_star
2967# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2968 uss_c = us_c
2969# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2970 f_hlld(9) = f_l(9) + s_l*(us_c - u_l(9))
2971# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2972 if (zone == 2) f_hlld(9) = f_hlld(9) + s_lstar*(uss_c &
2973# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2974 & - us_c)
2975# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2976 us_c = rhol_star*tau_nt_l
2977# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2978 uss_c = rhol_star*tau_nt_star
2979# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2980 f_hlld(10) = f_l(10) + s_l*(us_c - u_l(10))
2981# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2982 if (zone == 2) f_hlld(10) = f_hlld(10) + s_lstar*(uss_c &
2983# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2984 & - us_c)
2985# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2986 us_c = rhol_star*tau_nt2_l
2987# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2988 uss_c = rhol_star*tau_nt2_star
2989# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2990 f_hlld(11) = f_l(11) + s_l*(us_c - u_l(11))
2991# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2992 if (zone == 2) f_hlld(11) = f_hlld(11) + s_lstar*(uss_c &
2993# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2994 & - us_c)
2995# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2996 us_c = rhol_star*tau_tt_l_star
2997# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
2998 uss_c = rhol_star*tau_tt_l_starstar
2999# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3000 f_hlld(12) = f_l(12) + s_l*(us_c - u_l(12))
3001# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3002 if (zone == 2) f_hlld(12) = f_hlld(12) + s_lstar*(uss_c &
3003# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3004 & - us_c)
3005# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3006 us_c = rhol_star*tau_t2t2_l_star
3007# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3008 uss_c = rhol_star*tau_t2t2_l_starstar
3009# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3010 f_hlld(13) = f_l(13) + s_l*(us_c - u_l(13))
3011# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3012 if (zone == 2) f_hlld(13) = f_hlld(13) + s_lstar*(uss_c &
3013# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3014 & - us_c)
3015# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3016 us_c = rhol_star*tau_t1t2_l_star
3017# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3018 uss_c = rhol_star*tau_t1t2_l_starstar
3019# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3020 f_hlld(14) = f_l(14) + s_l*(us_c - u_l(14))
3021# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3022 if (zone == 2) f_hlld(14) = f_hlld(14) + s_lstar*(uss_c &
3023# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3024 & - us_c)
3025# 739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3026 else
3027# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3028 us_c = u_l(1)*fac_l
3029# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3030 uss_c = us_c
3031# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3032 f_hlld(1) = f_l(1) + s_l*(us_c - u_l(1))
3033# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3034 if (zone == 2) f_hlld(1) = f_hlld(1) + s_lstar*(uss_c &
3035# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3036 & - us_c)
3037# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3038 us_c = u_l(2)*fac_l
3039# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3040 uss_c = us_c
3041# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3042 f_hlld(2) = f_l(2) + s_l*(us_c - u_l(2))
3043# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3044 if (zone == 2) f_hlld(2) = f_hlld(2) + s_lstar*(uss_c &
3045# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3046 & - us_c)
3047# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3048 us_c = rhol_star*s_m
3049# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3050 uss_c = us_c
3051# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3052 f_hlld(3) = f_l(3) + s_l*(us_c - u_l(3))
3053# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3054 if (zone == 2) f_hlld(3) = f_hlld(3) + s_lstar*(uss_c &
3055# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3056 & - us_c)
3057# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3058 us_c = rhol_star*u_t_l
3059# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3060 uss_c = rhol_star*u_t_star
3061# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3062 f_hlld(4) = f_l(4) + s_l*(us_c - u_l(4))
3063# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3064 if (zone == 2) f_hlld(4) = f_hlld(4) + s_lstar*(uss_c &
3065# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3066 & - us_c)
3067# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3068 us_c = e_l_star
3069# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3070 uss_c = e_l_starstar
3071# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3072 f_hlld(5) = f_l(5) + s_l*(us_c - u_l(5))
3073# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3074 if (zone == 2) f_hlld(5) = f_hlld(5) + s_lstar*(uss_c &
3075# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3076 & - us_c)
3077# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3078 us_c = alpha1_l_star
3079# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3080 uss_c = us_c
3081# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3082 f_hlld(6) = f_l(6) + s_l*(us_c - u_l(6))
3083# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3084 if (zone == 2) f_hlld(6) = f_hlld(6) + s_lstar*(uss_c &
3085# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3086 & - us_c)
3087# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3088 us_c = alpha2_l_star
3089# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3090 uss_c = us_c
3091# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3092 f_hlld(7) = f_l(7) + s_l*(us_c - u_l(7))
3093# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3094 if (zone == 2) f_hlld(7) = f_hlld(7) + s_lstar*(uss_c &
3095# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3096 & - us_c)
3097# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3098 us_c = rhol_star*tau_nn_l_star
3099# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3100 uss_c = us_c
3101# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3102 f_hlld(8) = f_l(8) + s_l*(us_c - u_l(8))
3103# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3104 if (zone == 2) f_hlld(8) = f_hlld(8) + s_lstar*(uss_c &
3105# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3106 & - us_c)
3107# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3108 us_c = rhol_star*tau_nt_l
3109# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3110 uss_c = rhol_star*tau_nt_star
3111# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3112 f_hlld(9) = f_l(9) + s_l*(us_c - u_l(9))
3113# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3114 if (zone == 2) f_hlld(9) = f_hlld(9) + s_lstar*(uss_c &
3115# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3116 & - us_c)
3117# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3118 us_c = rhol_star*tau_tt_l_star
3119# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3120 uss_c = rhol_star*tau_tt_l_starstar
3121# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3122 f_hlld(10) = f_l(10) + s_l*(us_c - u_l(10))
3123# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3124 if (zone == 2) f_hlld(10) = f_hlld(10) + s_lstar*(uss_c &
3125# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3126 & - us_c)
3127# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3128 us_c = rhol_star*tau_qq_l_star
3129# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3130 uss_c = us_c
3131# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3132 f_hlld(11) = f_l(11) + s_l*(us_c - u_l(11))
3133# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3134 if (zone == 2) f_hlld(11) = f_hlld(11) + s_lstar*(uss_c &
3135# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3136 & - us_c)
3137# 747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3138 end if
3139# 726 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3140 else if (zone == 3 .or. zone == 4) then
3141# 727 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3142 ! R side of the fan: per component, us_c/uss_c are the selected side's
3143# 728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3144 ! star/starstar states (the old F_starR is folded into the first F_hlld
3145# 729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3146 ! statement; the starstar correction applies in zone 3 only, with the
3147# 730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3148 ! left-associative order of the materialized form preserved)
3149 if (p > 0 .and. .not. cyl_coord) then
3150# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3151 us_c = u_r(1)*fac_r
3152# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3153 uss_c = us_c
3154# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3155 f_hlld(1) = f_r(1) + s_r*(us_c - u_r(1))
3156# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3157 if (zone == 3) f_hlld(1) = f_hlld(1) + s_rstar*(uss_c &
3158# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3159 & - us_c)
3160# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3161 us_c = u_r(2)*fac_r
3162# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3163 uss_c = us_c
3164# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3165 f_hlld(2) = f_r(2) + s_r*(us_c - u_r(2))
3166# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3167 if (zone == 3) f_hlld(2) = f_hlld(2) + s_rstar*(uss_c &
3168# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3169 & - us_c)
3170# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3171 us_c = rhor_star*s_m
3172# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3173 uss_c = us_c
3174# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3175 f_hlld(3) = f_r(3) + s_r*(us_c - u_r(3))
3176# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3177 if (zone == 3) f_hlld(3) = f_hlld(3) + s_rstar*(uss_c &
3178# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3179 & - us_c)
3180# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3181 us_c = rhor_star*u_t_r
3182# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3183 uss_c = rhor_star*u_t_star
3184# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3185 f_hlld(4) = f_r(4) + s_r*(us_c - u_r(4))
3186# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3187 if (zone == 3) f_hlld(4) = f_hlld(4) + s_rstar*(uss_c &
3188# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3189 & - us_c)
3190# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3191 us_c = rhor_star*u_t2_r
3192# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3193 uss_c = rhor_star*u_t2_star
3194# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3195 f_hlld(5) = f_r(5) + s_r*(us_c - u_r(5))
3196# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3197 if (zone == 3) f_hlld(5) = f_hlld(5) + s_rstar*(uss_c &
3198# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3199 & - us_c)
3200# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3201 us_c = e_r_star
3202# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3203 uss_c = e_r_starstar
3204# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3205 f_hlld(6) = f_r(6) + s_r*(us_c - u_r(6))
3206# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3207 if (zone == 3) f_hlld(6) = f_hlld(6) + s_rstar*(uss_c &
3208# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3209 & - us_c)
3210# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3211 us_c = alpha1_r_star
3212# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3213 uss_c = us_c
3214# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3215 f_hlld(7) = f_r(7) + s_r*(us_c - u_r(7))
3216# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3217 if (zone == 3) f_hlld(7) = f_hlld(7) + s_rstar*(uss_c &
3218# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3219 & - us_c)
3220# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3221 us_c = alpha2_r_star
3222# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3223 uss_c = us_c
3224# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3225 f_hlld(8) = f_r(8) + s_r*(us_c - u_r(8))
3226# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3227 if (zone == 3) f_hlld(8) = f_hlld(8) + s_rstar*(uss_c &
3228# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3229 & - us_c)
3230# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3231 us_c = rhor_star*tau_nn_r_star
3232# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3233 uss_c = us_c
3234# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3235 f_hlld(9) = f_r(9) + s_r*(us_c - u_r(9))
3236# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3237 if (zone == 3) f_hlld(9) = f_hlld(9) + s_rstar*(uss_c &
3238# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3239 & - us_c)
3240# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3241 us_c = rhor_star*tau_nt_r
3242# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3243 uss_c = rhor_star*tau_nt_star
3244# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3245 f_hlld(10) = f_r(10) + s_r*(us_c - u_r(10))
3246# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3247 if (zone == 3) f_hlld(10) = f_hlld(10) + s_rstar*(uss_c &
3248# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3249 & - us_c)
3250# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3251 us_c = rhor_star*tau_nt2_r
3252# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3253 uss_c = rhor_star*tau_nt2_star
3254# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3255 f_hlld(11) = f_r(11) + s_r*(us_c - u_r(11))
3256# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3257 if (zone == 3) f_hlld(11) = f_hlld(11) + s_rstar*(uss_c &
3258# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3259 & - us_c)
3260# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3261 us_c = rhor_star*tau_tt_r_star
3262# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3263 uss_c = rhor_star*tau_tt_r_starstar
3264# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3265 f_hlld(12) = f_r(12) + s_r*(us_c - u_r(12))
3266# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3267 if (zone == 3) f_hlld(12) = f_hlld(12) + s_rstar*(uss_c &
3268# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3269 & - us_c)
3270# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3271 us_c = rhor_star*tau_t2t2_r_star
3272# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3273 uss_c = rhor_star*tau_t2t2_r_starstar
3274# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3275 f_hlld(13) = f_r(13) + s_r*(us_c - u_r(13))
3276# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3277 if (zone == 3) f_hlld(13) = f_hlld(13) + s_rstar*(uss_c &
3278# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3279 & - us_c)
3280# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3281 us_c = rhor_star*tau_t1t2_r_star
3282# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3283 uss_c = rhor_star*tau_t1t2_r_starstar
3284# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3285 f_hlld(14) = f_r(14) + s_r*(us_c - u_r(14))
3286# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3287 if (zone == 3) f_hlld(14) = f_hlld(14) + s_rstar*(uss_c &
3288# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3289 & - us_c)
3290# 739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3291 else
3292# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3293 us_c = u_r(1)*fac_r
3294# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3295 uss_c = us_c
3296# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3297 f_hlld(1) = f_r(1) + s_r*(us_c - u_r(1))
3298# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3299 if (zone == 3) f_hlld(1) = f_hlld(1) + s_rstar*(uss_c &
3300# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3301 & - us_c)
3302# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3303 us_c = u_r(2)*fac_r
3304# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3305 uss_c = us_c
3306# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3307 f_hlld(2) = f_r(2) + s_r*(us_c - u_r(2))
3308# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3309 if (zone == 3) f_hlld(2) = f_hlld(2) + s_rstar*(uss_c &
3310# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3311 & - us_c)
3312# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3313 us_c = rhor_star*s_m
3314# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3315 uss_c = us_c
3316# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3317 f_hlld(3) = f_r(3) + s_r*(us_c - u_r(3))
3318# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3319 if (zone == 3) f_hlld(3) = f_hlld(3) + s_rstar*(uss_c &
3320# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3321 & - us_c)
3322# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3323 us_c = rhor_star*u_t_r
3324# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3325 uss_c = rhor_star*u_t_star
3326# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3327 f_hlld(4) = f_r(4) + s_r*(us_c - u_r(4))
3328# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3329 if (zone == 3) f_hlld(4) = f_hlld(4) + s_rstar*(uss_c &
3330# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3331 & - us_c)
3332# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3333 us_c = e_r_star
3334# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3335 uss_c = e_r_starstar
3336# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3337 f_hlld(5) = f_r(5) + s_r*(us_c - u_r(5))
3338# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3339 if (zone == 3) f_hlld(5) = f_hlld(5) + s_rstar*(uss_c &
3340# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3341 & - us_c)
3342# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3343 us_c = alpha1_r_star
3344# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3345 uss_c = us_c
3346# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3347 f_hlld(6) = f_r(6) + s_r*(us_c - u_r(6))
3348# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3349 if (zone == 3) f_hlld(6) = f_hlld(6) + s_rstar*(uss_c &
3350# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3351 & - us_c)
3352# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3353 us_c = alpha2_r_star
3354# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3355 uss_c = us_c
3356# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3357 f_hlld(7) = f_r(7) + s_r*(us_c - u_r(7))
3358# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3359 if (zone == 3) f_hlld(7) = f_hlld(7) + s_rstar*(uss_c &
3360# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3361 & - us_c)
3362# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3363 us_c = rhor_star*tau_nn_r_star
3364# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3365 uss_c = us_c
3366# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3367 f_hlld(8) = f_r(8) + s_r*(us_c - u_r(8))
3368# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3369 if (zone == 3) f_hlld(8) = f_hlld(8) + s_rstar*(uss_c &
3370# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3371 & - us_c)
3372# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3373 us_c = rhor_star*tau_nt_r
3374# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3375 uss_c = rhor_star*tau_nt_star
3376# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3377 f_hlld(9) = f_r(9) + s_r*(us_c - u_r(9))
3378# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3379 if (zone == 3) f_hlld(9) = f_hlld(9) + s_rstar*(uss_c &
3380# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3381 & - us_c)
3382# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3383 us_c = rhor_star*tau_tt_r_star
3384# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3385 uss_c = rhor_star*tau_tt_r_starstar
3386# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3387 f_hlld(10) = f_r(10) + s_r*(us_c - u_r(10))
3388# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3389 if (zone == 3) f_hlld(10) = f_hlld(10) + s_rstar*(uss_c &
3390# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3391 & - us_c)
3392# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3393 us_c = rhor_star*tau_qq_r_star
3394# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3395 uss_c = us_c
3396# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3397 f_hlld(11) = f_r(11) + s_r*(us_c - u_r(11))
3398# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3399 if (zone == 3) f_hlld(11) = f_hlld(11) + s_rstar*(uss_c &
3400# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3401 & - us_c)
3402# 747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3403 end if
3404# 749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3405 end if
3406
3407 ! ADC blending (HLLD / HLL)
3408
3409 if (riemann_hypo_adc) then
3410 ! Register-diet form: the HLL flux enters per component as the scalar F_HLL_c
3411 ! instead of a materialized F_HLL array; outside the subsonic fan F_HLL equals
3412 ! F_hlld and the identity blend is kept explicitly so the arithmetic (including
3413 ! signed-zero behavior) matches the array form bit-for-bit.
3414 ! phi is anchor-independent: computed once in the shared section above
3415 if (s_l < 0._wp .and. s_r > 0._wp) then
3416 do i = 1, ncomp
3417 f_hll_c = f_hll_flux(s_l, s_r, f_l(i), f_r(i), u_l(i), u_r(i))
3418 f_hlld(i) = f_hll_c + phi*(f_hlld(i) - f_hll_c)
3419 end do
3420 else
3421 do i = 1, ncomp
3422 f_hll_c = f_hlld(i)
3423 f_hlld(i) = f_hll_c + phi*(f_hlld(i) - f_hll_c)
3424 end do
3425 end if
3426 end if
3427 end if
3428
3429 ! HLL face traces for the axisymmetric completion: consumed by the ADC face-state blend on
3430 ! valid fans and by the face exports on fallback faces (whose conservative flux is the
3431 ! matching HLL/one-sided flux). Rows 8/11 carry the pass's anchored folds, so the traces
3432 ! are anchor-dependent, like the ADC reference they generalize.
3433 if (cyl_coord .and. (riemann_hypo_adc .or. fan_fallback)) then
3434 if (0._wp <= s_l) then
3435 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l
3436 p_face_hll = pres%L; tau_qq_face_hll = tau_qq_l
3437 else if (s_r <= 0._wp) then
3438 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r
3439 p_face_hll = pres%R; tau_qq_face_hll = tau_qq_r
3440 else
3441 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
3442 u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
3443 ! Only HLL-state components 1, 2, 3, 8 and 11 feed the axisym trace
3444 u_hll_c = (s_r*u_r(1) - s_l*u_l(1) - (f_r(1) - f_l(1)))/(s_r - s_l + verysmall)
3445 rho_hll = u_hll_c
3446 u_hll_c = (s_r*u_r(2) - s_l*u_l(2) - (f_r(2) - f_l(2)))/(s_r - s_l + verysmall)
3447 rho_hll = rho_hll + u_hll_c
3448 u_hll_c = (s_r*u_r(3) - s_l*u_l(3) - (f_r(3) - f_l(3)))/(s_r - s_l + verysmall)
3449 u_n_hll_cons = u_hll_c/(rho_hll + verysmall)
3450 u_hll_c = (s_r*u_r(8) - s_l*u_l(8) - (f_r(8) - f_l(8)))/(s_r - s_l + verysmall)
3451 tau_nn_hll = u_hll_c/(rho_hll + verysmall)
3452 u_hll_c = (s_r*u_r(11) - s_l*u_l(11) - (f_r(11) - f_l(11)))/(s_r - s_l + verysmall)
3453 tau_qq_face_hll = u_hll_c/(rho_hll + verysmall)
3454 ! This branch implies S_L < 0 < S_R, so component 3 of F_HLL is the interior HLL flux
3455 f_hll_c = f_hll_flux(s_l, s_r, f_l(3), f_r(3), u_l(3), u_r(3))
3456 p_face_hll = f_hll_c - rho_hll*u_n_hll_cons*u_n_hll_cons + tau_nn_hll
3457 end if
3458 end if
3459
3460 ! Reorder F_HLLD for output: pass 1 (hat_L) -> flux_rs*, pass 2 (hat_R) -> flux_hatR_rs*
3461# 806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3462 if (ipass == 1) then
3463# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3464 if (p > 0 .and. .not. cyl_coord) then
3465 ! 3D Cartesian: 14-state -> physical indices
3466 flux_rsx_vf(j, k, l, 1) = f_hlld(1)
3467# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3468 flux_rsx_vf(j, k, l, 2) = f_hlld(2)
3469# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3470 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
3471# 812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3472 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
3473# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3474 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(5)
3475# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3476 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(6)
3477# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3478 flux_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(7)
3479# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3480 flux_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(8)
3481# 817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3482 ! Map local stress to physical stress indices
3483 if (dir_idx(1) == 1) then
3484 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(9) ! tau_nn=tau_xx
3485# 820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3486 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
3487# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3488 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(12) ! tau_t1t1=tau_yy
3489# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3490 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(11) ! tau_nt2=tau_xz
3491# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3492 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(14) ! tau_t1t2=tau_yz
3493# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3494 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
3495# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3496 else if (dir_idx(1) == 2) then
3497 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
3498# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3499 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
3500# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3501 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(9) ! tau_nn=tau_yy
3502# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3503 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(14) ! tau_t1t2=tau_xz
3504# 830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3505 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
3506# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3507 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
3508# 832 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3509 else
3510 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
3511# 834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3512 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(14) ! tau_t1t2=tau_xy
3513# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3514 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(13) ! tau_t2t2=tau_yy
3515# 836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3516 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(10) ! tau_nt1=tau_xz
3517# 837 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3518 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
3519# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3520 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(9) ! tau_nn=tau_zz
3521# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3522 end if
3523 else
3524 ! 2D/axisym: 11-state (unchanged)
3525 flux_rsx_vf(j, k, l, 1) = f_hlld(1)
3526# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3527 flux_rsx_vf(j, k, l, 2) = f_hlld(2)
3528# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3529 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
3530# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3531 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
3532# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3533 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(5)
3534# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3535 flux_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(6)
3536# 848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3537 flux_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(7)
3538# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3539 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(9)
3540# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3541 if (dir_idx(1) == 1) then
3542 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(8)
3543# 852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3544 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(10)
3545# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3546 else
3547 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(10)
3548# 855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3549 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(8)
3550# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3551 end if
3552 if (cyl_coord) then
3553 flux_rsx_vf(j, k, l, eqn_idx%stress%end) = f_hlld(11)
3554# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3555 end if
3556 end if
3557 end if
3558# 806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3559 if (ipass == 2) then
3560# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3561 if (p > 0 .and. .not. cyl_coord) then
3562 ! 3D Cartesian: 14-state -> physical indices
3563 flux_hatr_rsx_vf(j, k, l, 1) = f_hlld(1)
3564# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3565 flux_hatr_rsx_vf(j, k, l, 2) = f_hlld(2)
3566# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3567 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
3568# 812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3569 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
3570# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3571 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(5)
3572# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3573 flux_hatr_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(6)
3574# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3575 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(7)
3576# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3577 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(8)
3578# 817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3579 ! Map local stress to physical stress indices
3580 if (dir_idx(1) == 1) then
3581 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(9) ! tau_nn=tau_xx
3582# 820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3583 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
3584# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3585 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(12) ! tau_t1t1=tau_yy
3586# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3587 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(11) ! tau_nt2=tau_xz
3588# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3589 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(14) ! tau_t1t2=tau_yz
3590# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3591 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
3592# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3593 else if (dir_idx(1) == 2) then
3594 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
3595# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3596 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
3597# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3598 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(9) ! tau_nn=tau_yy
3599# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3600 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(14) ! tau_t1t2=tau_xz
3601# 830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3602 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
3603# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3604 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
3605# 832 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3606 else
3607 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
3608# 834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3609 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(14) ! tau_t1t2=tau_xy
3610# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3611 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(13) ! tau_t2t2=tau_yy
3612# 836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3613 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(10) ! tau_nt1=tau_xz
3614# 837 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3615 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
3616# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3617 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(9) ! tau_nn=tau_zz
3618# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3619 end if
3620 else
3621 ! 2D/axisym: 11-state (unchanged)
3622 flux_hatr_rsx_vf(j, k, l, 1) = f_hlld(1)
3623# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3624 flux_hatr_rsx_vf(j, k, l, 2) = f_hlld(2)
3625# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3626 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
3627# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3628 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
3629# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3630 flux_hatr_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(5)
3631# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3632 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(6)
3633# 848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3634 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(7)
3635# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3636 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(9)
3637# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3638 if (dir_idx(1) == 1) then
3639 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(8)
3640# 852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3641 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(10)
3642# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3643 else
3644 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(10)
3645# 855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3646 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(8)
3647# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3648 end if
3649 if (cyl_coord) then
3650 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%end) = f_hlld(11)
3651# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3652 end if
3653 end if
3654 end if
3655# 863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3656
3657 ! Export face velocities for axisym hypo source terms
3658 if (grid_geometry == 2) then
3659 if (fan_fallback) then
3660 ! Fallback face: the conservative flux is the HLL/one-sided flux, so export the
3661 ! matching HLL/one-sided traces, not the rejected fan's contact speed/star states
3662 u_n_face = u_n_hll_trace; u_t_face = u_t_hll_trace
3663 else
3664 ! Upwind by wave-fan wedge: the inner zones ride the contact (u_n = S_M) and the
3665 ! tangential state switches L -> star -> R across the shear waves (zones 2 and 3
3666 ! share the tangential star state)
3667 if (zone == 0) then
3668 u_n_face = u_n_l; u_t_face = u_t_l
3669 else if (zone == 1) then
3670 u_n_face = s_m; u_t_face = u_t_l
3671 else if (zone <= 3) then
3672 u_n_face = s_m; u_t_face = u_t_star
3673 else if (zone == 4) then
3674 u_n_face = s_m; u_t_face = u_t_r
3675 else
3676 u_n_face = u_n_r; u_t_face = u_t_r
3677 end if
3678 ! ADC blend NC face velocities with HLL scalar traces (valid fans; a fallback
3679 ! face already exports the pure HLL traces)
3680 if (riemann_hypo_adc) then
3681 u_n_face = u_n_hll_trace + phi*(u_n_face - u_n_hll_trace)
3682 u_t_face = u_t_hll_trace + phi*(u_t_face - u_t_hll_trace)
3683 end if
3684 end if
3685# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3686 if (ipass == 1) then
3687# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3688 if (dir_idx(1) == 1) then
3689 nc_iface_vel_rsx_vf(j, k, l, 1) = u_n_face
3690# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3691 nc_iface_vel_rsx_vf(j, k, l, 2) = u_t_face
3692# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3693 else
3694 nc_iface_vel_rsx_vf(j, k, l, 1) = u_t_face
3695# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3696 nc_iface_vel_rsx_vf(j, k, l, 2) = u_n_face
3697# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3698 end if
3699 end if
3700# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3701 if (ipass == 2) then
3702# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3703 if (dir_idx(1) == 1) then
3704 nc_iface_vel_hatr_rsx_vf(j, k, l, 1) = u_n_face
3705# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3706 nc_iface_vel_hatr_rsx_vf(j, k, l, 2) = u_t_face
3707# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3708 else
3709 nc_iface_vel_hatr_rsx_vf(j, k, l, 1) = u_t_face
3710# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3711 nc_iface_vel_hatr_rsx_vf(j, k, l, 2) = u_n_face
3712# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3713 end if
3714 end if
3715# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3716 end if
3717
3718 ! Radial geometric source flux for cylindrical coordinates. Only genuinely conservative rows
3719 ! (masses, momenta, energy) carry a numerical geometric flux: their full radial flux IS the
3720 ! -H/r metric quantity. The volume-fraction and stress rows are zeroed: the augmented stress
3721 ! fluxes fold constitutive velocity terms that must not be divided by r; their complete
3722 ! cylindrical completion is the cell-local dual-pass source
3723 ! (s_compute_hypoelastic_rhs_axisym_geom_dual_pass).
3724# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3725 if (cyl_coord) then
3726# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3727 if (ipass == 1) then
3728# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3729
3730# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3731#if defined(MFC_OpenACC)
3732# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3733!$acc loop seq
3734# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3735#elif defined(MFC_OpenMP)
3736# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3737
3738# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3739#endif
3740# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3741 do i = 1, eqn_idx%E
3742 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
3743# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3744 end do
3745 if (fan_fallback) then
3746 ! Fallback face: HLL/one-sided face state, consistent with the
3747 ! selected conservative flux
3748 p_face = p_face_hll; tau_qq_face = tau_qq_face_hll
3749 else
3750 ! Pure HLLD face state, upwinded by wave-fan wedge (left/right of the contact)
3751 if (zone == 0) then
3752 p_face = pres%L; tau_qq_face = tau_qq_l
3753 else if (zone <= 2) then
3754 p_face = ptot_star + tau_nn_l_star; tau_qq_face = tau_qq_l_star
3755 else if (zone <= 4) then
3756 p_face = ptot_star + tau_nn_r_star; tau_qq_face = tau_qq_r_star
3757 else
3758 p_face = pres%R; tau_qq_face = tau_qq_r
3759 end if
3760 ! ADC blend face state (valid fans; a fallback face already uses the
3761 ! pure HLL state)
3762 if (riemann_hypo_adc) then
3763 p_face = p_face_hll + phi*(p_face - p_face_hll)
3764 tau_qq_face = tau_qq_face_hll + phi*(tau_qq_face - tau_qq_face_hll)
3765 end if
3766 end if
3767 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = flux_rsx_vf(j, k, l, &
3768# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3769 & eqn_idx%cont%end + dir_idx(1)) - p_face + tau_qq_face
3770 ! Every HLLD-legal configuration places only the volume-fraction and stress rows
3771 ! above eqn_idx%E (see check_hypoelasticity in toolchain/mfc/case_validator.py)
3772
3773# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3774#if defined(MFC_OpenACC)
3775# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3776!$acc loop seq
3777# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3778#elif defined(MFC_OpenMP)
3779# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3780
3781# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3782#endif
3783# 947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3784 do i = eqn_idx%adv%beg, sys_size
3785 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
3786# 949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3787 end do
3788 end if
3789# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3790 if (ipass == 2) then
3791# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3792
3793# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3794#if defined(MFC_OpenACC)
3795# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3796!$acc loop seq
3797# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3798#elif defined(MFC_OpenMP)
3799# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3800
3801# 916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3802#endif
3803# 917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3804 do i = 1, eqn_idx%E
3805 flux_gsrc_hatr_rsx_vf(j, k, l, i) = flux_hatr_rsx_vf(j, k, l, i)
3806# 919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3807 end do
3808 if (fan_fallback) then
3809 ! Fallback face: HLL/one-sided face state, consistent with the
3810 ! selected conservative flux
3811 p_face = p_face_hll; tau_qq_face = tau_qq_face_hll
3812 else
3813 ! Pure HLLD face state, upwinded by wave-fan wedge (left/right of the contact)
3814 if (zone == 0) then
3815 p_face = pres%L; tau_qq_face = tau_qq_l
3816 else if (zone <= 2) then
3817 p_face = ptot_star + tau_nn_l_star; tau_qq_face = tau_qq_l_star
3818 else if (zone <= 4) then
3819 p_face = ptot_star + tau_nn_r_star; tau_qq_face = tau_qq_r_star
3820 else
3821 p_face = pres%R; tau_qq_face = tau_qq_r
3822 end if
3823 ! ADC blend face state (valid fans; a fallback face already uses the
3824 ! pure HLL state)
3825 if (riemann_hypo_adc) then
3826 p_face = p_face_hll + phi*(p_face - p_face_hll)
3827 tau_qq_face = tau_qq_face_hll + phi*(tau_qq_face - tau_qq_face_hll)
3828 end if
3829 end if
3830 flux_gsrc_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = flux_hatr_rsx_vf(j, k, l, &
3831# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3832 & eqn_idx%cont%end + dir_idx(1)) - p_face + tau_qq_face
3833 ! Every HLLD-legal configuration places only the volume-fraction and stress rows
3834 ! above eqn_idx%E (see check_hypoelasticity in toolchain/mfc/case_validator.py)
3835
3836# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3837#if defined(MFC_OpenACC)
3838# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3839!$acc loop seq
3840# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3841#elif defined(MFC_OpenMP)
3842# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3843
3844# 946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3845#endif
3846# 947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3847 do i = eqn_idx%adv%beg, sys_size
3848 flux_gsrc_hatr_rsx_vf(j, k, l, i) = 0._wp
3849# 949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3850 end do
3851 end if
3852# 952 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3853 end if
3854# 954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3855 end do
3856
3857 ! Dual-pass HLLD: all NC terms stay inside the Riemann flux (anchor-independent; written once)
3858 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
3859# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3860 end do
3861 end do
3862 end do
3863
3864# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3865#if defined(MFC_OpenACC)
3866# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3867!$acc end parallel loop
3868# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3869#elif defined(MFC_OpenMP)
3870# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3871
3872# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3873!$omp end target teams loop
3874# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3875#endif
3876# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3877 end if
3878# 178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3879# 179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3880# 180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3881 if (norm_dir == 3) then
3882# 181 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3883 ! Anchor-cell index pattern: the fused kernel reads both anchors (hat_L: face cell, hat_R: face cell + 1)
3884 ! directly from q_prim_vf; loop indices are physical, so the offset rides the stencil index.
3885# 184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3886 ! The fused HLLD kernel privatizes ~150 scalars -- a private() list large enough that
3887 ! the single clause must be wrapped across continuation lines. The four fragments
3888 ! (_hlld_p1..p4) are ONLY for source readability; fypp concatenates them into one
3889 ! clause below. That wrapping is FOLD_DIRECTIVE's job -- its within-clause comma split
3890 ! exists for exactly this case -- not the fragments'.
3891# 190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3892# 191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3893# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3894# 193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3895 ! Wave-fan side table for the per-component F_hlld fold below: side name, the side's two zones,
3896 ! its starstar zone, and the outer/inner wave speeds. The L and R sides are mirror images.
3897# 196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3898 ! Wave-fan component tables for the per-component fold below: (us, uss) expression pairs in
3899 ! F_hlld component order; uss = None means the inner (starstar) correction leaves the
3900 ! component unchanged (uss_c = us_c). '{S}' expands to the fan side (L/R).
3901# 213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3902# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3903
3904# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3905
3906# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3907#if defined(MFC_OpenACC)
3908# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3909!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, ipass, degenerate, shear_degenerate, fan_fallback, shear_cond, alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, &
3910# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3911!$acc& pres, E, gamma, pi_inf, qv, vel_rms, c, S_L, S_R, s_M, S_Lstar, S_Rstar, pTot_L, pTot_R, rhoL_star, rhoR_star, U_L, U_R, F_L, F_R, F_hlld, us_c, uss_c, zone, F_HLL_c, U_HLL_c, rho_HLL, &
3912# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3913!$acc& u_n_HLL_cons, tau_nn_HLL, u_n_HLL_trace, u_t_HLL_trace, p_face_HLL, tau_qq_face_HLL, ncomp, G_eff, G_eff_tol, C_NC, sqrtC_NC, A_L, A_R, denomA, fac_L, fac_R, u_n_L, u_t_L, u_n_R, u_t_R, u_t2_L, &
3914# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3915!$acc& u_t2_R, tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R, tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, G_L, G_R, tau_e_L, tau_e_R, &
3916# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3917!$acc& alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star, u_t_star, tau_nt_star, u_t2_star, tau_nt2_star, tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star, tau_tt_L_starstar, &
3918# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3919!$acc& tau_tt_R_starstar, tau_t2t2_L_star, tau_t2t2_R_star, tau_t2t2_L_starstar, tau_t2t2_R_starstar, tau_t1t2_L_star, tau_t1t2_R_star, tau_t1t2_L_starstar, tau_t1t2_R_starstar, tau_qq_L_star, &
3920# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3921!$acc& tau_qq_R_star, pTot_star, E_L_star, E_R_star, E_L_starstar, E_R_starstar, p_face, tau_qq_face, u_n_face, u_t_face, G_hat, rho_hat, tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat, tau_nt2_hat, &
3922# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3923!$acc& tau_t2t2_hat, tau_t1t2_hat, alpha_hat, alpha_rho_hat, tau_e_hat, pres_hat, blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q, C_hat_1, C_hat_2, Sigma_L, Sigma_R, dSigma, Sigma_ref, &
3924# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3925!$acc& a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, sensor_vt, sensor_tnt, sensor_combined, phi, alpha_L_sum, alpha_R_sum)
3926# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3927#elif defined(MFC_OpenMP)
3928# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3929
3930# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3931
3932# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3933
3934# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3935!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, &
3936# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3937!$omp& ipass, degenerate, shear_degenerate, fan_fallback, shear_cond, alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, gamma, pi_inf, qv, vel_rms, c, S_L, S_R, s_M, S_Lstar, S_Rstar, &
3938# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3939!$omp& pTot_L, pTot_R, rhoL_star, rhoR_star, U_L, U_R, F_L, F_R, F_hlld, us_c, uss_c, zone, F_HLL_c, U_HLL_c, rho_HLL, u_n_HLL_cons, tau_nn_HLL, u_n_HLL_trace, u_t_HLL_trace, p_face_HLL, &
3940# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3941!$omp& tau_qq_face_HLL, ncomp, G_eff, G_eff_tol, C_NC, sqrtC_NC, A_L, A_R, denomA, fac_L, fac_R, u_n_L, u_t_L, u_n_R, u_t_R, u_t2_L, u_t2_R, tau_nn_L, tau_nt_L, tau_tt_L, tau_nn_R, tau_nt_R, tau_tt_R, &
3942# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3943!$omp& tau_nt2_L, tau_nt2_R, tau_t2t2_L, tau_t2t2_R, tau_t1t2_L, tau_t1t2_R, tau_qq_L, tau_qq_R, G_L, G_R, tau_e_L, tau_e_R, alpha1_L_star, alpha1_R_star, alpha2_L_star, alpha2_R_star, u_t_star, &
3944# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3945!$omp& tau_nt_star, u_t2_star, tau_nt2_star, tau_nn_L_star, tau_nn_R_star, tau_tt_L_star, tau_tt_R_star, tau_tt_L_starstar, tau_tt_R_starstar, tau_t2t2_L_star, tau_t2t2_R_star, tau_t2t2_L_starstar, &
3946# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3947!$omp& tau_t2t2_R_starstar, tau_t1t2_L_star, tau_t1t2_R_star, tau_t1t2_L_starstar, tau_t1t2_R_starstar, tau_qq_L_star, tau_qq_R_star, pTot_star, E_L_star, E_R_star, E_L_starstar, E_R_starstar, p_face, &
3948# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3949!$omp& tau_qq_face, u_n_face, u_t_face, G_hat, rho_hat, tau_nn_hat, tau_nt_hat, tau_tt_hat, tau_qq_hat, tau_nt2_hat, tau_t2t2_hat, tau_t1t2_hat, alpha_hat, alpha_rho_hat, tau_e_hat, pres_hat, &
3950# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3951!$omp& blkmod1_hat, blkmod2_hat, K_hat, alpha_hat_q, alpha_rho_hat_q, C_hat_1, C_hat_2, Sigma_L, Sigma_R, dSigma, Sigma_ref, a_L_ref, a_R_ref, a_ref, du_t, dtau_nt, du_t2, dtau_nt2, sensor_ptot, &
3952# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3953!$omp& sensor_vt, sensor_tnt, sensor_combined, phi, alpha_L_sum, alpha_R_sum)
3954# 224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3955#endif
3956# 225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3957 do l = is1%beg, is1%end
3958# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3959 do k = is2%beg, is2%end
3960# 227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3961 do j = is3%beg, is3%end
3962# 228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3963 ! Extract left/right primitive states
3964
3965 do i = 1, eqn_idx%cont%end
3966 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3967# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3968 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
3969# 233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3970 end do
3971
3972 ! Initialize the unused third velocity component in 2D
3973 vel%L = 0._wp
3974 vel%R = 0._wp
3975
3976 ! Load velocities in physical-coordinate order; map directional aliases below via dir_idx
3977 do i = 1, num_vels
3978 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3979# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3980 vel%R(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
3981# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3982 end do
3983
3984 vel_rms%L = vel%L(1)**2 + vel%L(2)**2 + vel%L(3)**2
3985 vel_rms%R = vel%R(1)**2 + vel%R(2)**2 + vel%R(3)**2
3986
3987 do i = 1, num_fluids
3988 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3989# 250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3990 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
3991# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
3992 end do
3993
3994 ! Clamp and renormalize volume fractions when mpp_lim is on (match HLL/HLLC)
3995 alpha_l_sum = 0._wp
3996 alpha_r_sum = 0._wp
3997 if (mpp_lim) then
3998 do i = 1, num_fluids
3999 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4000 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4001 alpha_l_sum = alpha_l_sum + alpha_l(i)
4002 end do
4003 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4004
4005 do i = 1, num_fluids
4006 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4007 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4008 alpha_r_sum = alpha_r_sum + alpha_r(i)
4009 end do
4010 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4011 end if
4012
4013 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4014# 273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4015 pres%R = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
4016# 274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4017
4018 ! Hypoelasticity
4019
4020# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4021#if defined(MFC_OpenACC)
4022# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4023!$acc loop seq
4024# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4025#elif defined(MFC_OpenMP)
4026# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4027
4028# 276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4029#endif
4030# 277 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4031 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4032 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4033# 279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4034 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
4035# 280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4036 end do
4037
4038 u_t2_l = 0._wp; u_t2_r = 0._wp
4039 tau_nt2_l = 0._wp; tau_nt2_r = 0._wp
4040 tau_t2t2_l = 0._wp; tau_t2t2_r = 0._wp
4041 tau_t1t2_l = 0._wp; tau_t1t2_r = 0._wp
4042
4043 ! Map physical-basis arrays to directional aliases via stress_perm/dir_idx
4044 u_n_l = vel%L(dir_idx(1)); u_n_r = vel%R(dir_idx(1))
4045 tau_nn_l = tau_e_l(stress_perm(1)); tau_nn_r = tau_e_r(stress_perm(1))
4046 if (n == 0) then
4047 ncomp = 11
4048 else if (p == 0) then
4049 ncomp = 11
4050 u_t_l = vel%L(dir_idx(2)); u_t_r = vel%R(dir_idx(2))
4051 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
4052 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
4053 else
4054 ncomp = 14
4055 u_t_l = vel%L(dir_idx(2)); u_t_r = vel%R(dir_idx(2))
4056 u_t2_l = vel%L(dir_idx(3)); u_t2_r = vel%R(dir_idx(3))
4057 tau_nt_l = tau_e_l(stress_perm(2)); tau_nt_r = tau_e_r(stress_perm(2))
4058 tau_tt_l = tau_e_l(stress_perm(3)); tau_tt_r = tau_e_r(stress_perm(3))
4059 tau_nt2_l = tau_e_l(stress_perm(4)); tau_nt2_r = tau_e_r(stress_perm(4))
4060 tau_t1t2_l = tau_e_l(stress_perm(5)); tau_t1t2_r = tau_e_r(stress_perm(5))
4061 tau_t2t2_l = tau_e_l(stress_perm(6)); tau_t2t2_r = tau_e_r(stress_perm(6))
4062 end if
4063 if (cyl_coord) then
4064 tau_qq_l = tau_e_l(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4065 tau_qq_r = tau_e_r(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4066 else
4067 tau_qq_l = 0._wp; tau_qq_r = 0._wp
4068 end if
4069 ! Total pressure (replace the usual pressure to define SM)
4070 ptot_l = pres%L - tau_nn_l
4071 ptot_r = pres%R - tau_nn_r
4072
4073 ! Symmetrize total pressure when it differs only by floating-point roundoff. WENO reconstruction of a
4074 ! uniform field can produce slightly different L/R values at material interfaces due to different
4075 ! smoothness indicators. With stiff materials (G~1e9), even 1e-12 relative pTot asymmetry creates O(1)
4076 ! spurious stress through the HLLD star-state.
4077 if (abs(ptot_r - ptot_l) < 1e-12_wp*max(abs(ptot_l), abs(ptot_r), 1._wp)) then
4078 ptot_l = 5e-1_wp*(ptot_l + ptot_r)
4079 ptot_r = ptot_l
4080 end if
4081
4082 call s_compute_mixture_coefficients(alpha_rho_l, alpha_l, rho%L, gamma%L, pi_inf%L, qv%L)
4083 call s_compute_mixture_coefficients(alpha_rho_r, alpha_r, rho%R, gamma%R, pi_inf%R, qv%R)
4084
4085 g_l = 0._wp; g_r = 0._wp
4086
4087# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4088#if defined(MFC_OpenACC)
4089# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4090!$acc loop seq
4091# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4092#elif defined(MFC_OpenMP)
4093# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4094
4095# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4096#endif
4097# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4098 do i = 1, num_fluids
4099 g_l = g_l + alpha_l(i)*gs_rs(i)
4100 g_r = g_r + alpha_r(i)*gs_rs(i)
4101 end do
4102
4103 call s_compute_energy(pres%L, alpha_rho_l, alpha_l, vel_rms%L, e%L)
4104 call s_compute_energy(pres%R, alpha_rho_r, alpha_r, vel_rms%R, e%R)
4105
4106 ! Freeze the thermal/kinetic enthalpy used by the EOS sound-speed call before
4107 ! adding hypoelastic strain energy to the conservative total energy.
4108
4109
4110# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4111#if defined(MFC_OpenACC)
4112# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4113!$acc loop seq
4114# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4115#elif defined(MFC_OpenMP)
4116# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4117
4118# 342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4119#endif
4120# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4121 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4122 shear_cond = (n > 0 .and. p == 0 .and. i == 2) .or. (p > 0 .and. (i == 2 .or. i == 4 .or. i == 5))
4123 e%L = e%L + f_elastic_energy(tau_e_l(i), g_l, shear_cond)
4124 e%R = e%R + f_elastic_energy(tau_e_r(i), g_r, shear_cond)
4125 end do
4126
4127 ! Compute Riemann states
4128
4129 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, alpha_l, c%L, alpha_rho_l)
4130 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, alpha_r, c%R, alpha_rho_r)
4131
4132 s_l = min(u_n_l - sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L)), &
4133 & u_n_r - sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R)))
4134 s_r = max(u_n_r + sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R)), &
4135 & u_n_l + sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L)))
4136
4137 if (p > 0 .and. .not. cyl_coord) then
4138 ! 3D Cartesian: 14-state compact basis
4139 u_l(1) = alpha_rho_l(1); u_r(1) = alpha_rho_r(1)
4140 u_l(2) = alpha_rho_l(2); u_r(2) = alpha_rho_r(2)
4141 u_l(3) = rho%L*u_n_l; u_r(3) = rho%R*u_n_r
4142 u_l(4) = rho%L*u_t_l; u_r(4) = rho%R*u_t_r
4143 u_l(5) = rho%L*u_t2_l; u_r(5) = rho%R*u_t2_r
4144 u_l(6) = e%L; u_r(6) = e%R
4145 u_l(7) = alpha_l(1); u_r(7) = alpha_r(1)
4146 u_l(8) = alpha_l(2); u_r(8) = alpha_r(2)
4147 u_l(9) = rho%L*tau_nn_l; u_r(9) = rho%R*tau_nn_r
4148 u_l(10) = rho%L*tau_nt_l; u_r(10) = rho%R*tau_nt_r
4149 u_l(11) = rho%L*tau_nt2_l; u_r(11) = rho%R*tau_nt2_r
4150 u_l(12) = rho%L*tau_tt_l; u_r(12) = rho%R*tau_tt_r
4151 u_l(13) = rho%L*tau_t2t2_l; u_r(13) = rho%R*tau_t2t2_r
4152 u_l(14) = rho%L*tau_t1t2_l; u_r(14) = rho%R*tau_t1t2_r
4153
4154 f_l(1) = u_l(1)*u_n_l; f_r(1) = u_r(1)*u_n_r
4155 f_l(2) = u_l(2)*u_n_l; f_r(2) = u_r(2)*u_n_r
4156 f_l(3) = rho%L*u_n_l*u_n_l + ptot_l
4157 f_r(3) = rho%R*u_n_r*u_n_r + ptot_r
4158 f_l(4) = rho%L*u_n_l*u_t_l - tau_nt_l
4159 f_r(4) = rho%R*u_n_r*u_t_r - tau_nt_r
4160 f_l(5) = rho%L*u_n_l*u_t2_l - tau_nt2_l
4161 f_r(5) = rho%R*u_n_r*u_t2_r - tau_nt2_r
4162 f_l(6) = (e%L + ptot_l)*u_n_l - u_t_l*tau_nt_l - u_t2_l*tau_nt2_l
4163 f_r(6) = (e%R + ptot_r)*u_n_r - u_t_r*tau_nt_r - u_t2_r*tau_nt2_r
4164 ! Rows 7-14 (volume fractions + stresses) carry the anchor-dependent hat coefficients and are filled
4165 ! inside the per-anchor pass loop below.
4166 else
4167 ! 2D/axisym: 11-state compact basis (unchanged)
4168 u_l(1) = alpha_rho_l(1)
4169 u_l(2) = alpha_rho_l(2)
4170 u_l(3) = rho%L*u_n_l
4171 u_l(4) = rho%L*u_t_l
4172 u_l(5) = e%L
4173 u_l(6) = alpha_l(1)
4174 u_l(7) = alpha_l(2)
4175 u_l(8) = rho%L*tau_nn_l
4176 u_l(9) = rho%L*tau_nt_l
4177 u_l(10) = rho%L*tau_tt_l
4178 u_l(11) = rho%L*tau_qq_l
4179
4180 u_r(1) = alpha_rho_r(1)
4181 u_r(2) = alpha_rho_r(2)
4182 u_r(3) = rho%R*u_n_r
4183 u_r(4) = rho%R*u_t_r
4184 u_r(5) = e%R
4185 u_r(6) = alpha_r(1)
4186 u_r(7) = alpha_r(2)
4187 u_r(8) = rho%R*tau_nn_r
4188 u_r(9) = rho%R*tau_nt_r
4189 u_r(10) = rho%R*tau_tt_r
4190 u_r(11) = rho%R*tau_qq_r
4191
4192 f_l(1) = u_l(1)*u_n_l
4193 f_l(2) = u_l(2)*u_n_l
4194 f_l(3) = rho%L*u_n_l*u_n_l + ptot_l
4195 f_l(4) = rho%L*u_n_l*u_t_l - tau_nt_l
4196 f_l(5) = (e%L + ptot_l)*u_n_l - u_t_l*tau_nt_l
4197
4198 f_r(1) = u_r(1)*u_n_r
4199 f_r(2) = u_r(2)*u_n_r
4200 f_r(3) = rho%R*u_n_r*u_n_r + ptot_r
4201 f_r(4) = rho%R*u_n_r*u_t_r - tau_nt_r
4202 f_r(5) = (e%R + ptot_r)*u_n_r - u_t_r*tau_nt_r
4203 ! Rows 6-11 (volume fractions + stresses) carry the anchor-dependent hat coefficients and are filled
4204 ! inside the per-anchor pass loop below.
4205 end if
4206
4207 a_l = rho%L*(s_l - u_n_l)
4208 a_r = rho%R*(s_r - u_n_r)
4209 denoma = (a_r - a_l)
4210
4211 s_m = ((ptot_r - ptot_l) + a_l*u_n_l - a_r*u_n_r)/(a_l - a_r + verysmall)
4212
4213 ! Degenerate wave structure: denom ~ 0 or S_M not in [S_L,S_R]. The test is anchor-independent, so both
4214 ! anchored solves below take the same branch.
4215 degenerate = (abs(denoma) < verysmall .or. .not. (s_l - verysmall <= s_m .and. s_m <= s_r + verysmall))
4216
4217 if (.not. degenerate) then
4218 ! Anchor-independent pieces of the star region (the anchor state enters only the volume-fraction and
4219 ! stress star states)
4220 ptot_star = ptot_l + a_l*(s_m - u_n_l)
4221
4222 ! Signed floor (HLLC-style, see m_riemann_solver_hllc.fpp) on the wave-fan denominators: guards the
4223 ! degenerate S_M -> S_L / S_M -> S_R limit, sign-preserving, and a no-op away from it (|denom| >>
4224 ! verysmall)
4225 rhol_star = rho%L*(s_l - u_n_l)/min(s_l - s_m, -verysmall)
4226 rhor_star = rho%R*(s_r - u_n_r)/max(s_r - s_m, verysmall)
4227 fac_l = (s_l - u_n_l)/min(s_l - s_m, -verysmall)
4228 fac_r = (s_r - u_n_r)/max(s_r - s_m, verysmall)
4229
4230 e_l_star = (e%L*(u_n_l - s_l) + u_n_l*ptot_l - s_m*ptot_star)/max(s_m - s_l, verysmall)
4231 e_r_star = (e%R*(u_n_r - s_r) + u_n_r*ptot_r - s_m*ptot_star)/min(s_m - s_r, -verysmall)
4232
4233 if (riemann_hypo_adc) then
4234 ! ADC sensors depend only on the L/R face states: computed once, shared by both anchored solves
4235 sigma_l = ptot_l
4236 sigma_r = ptot_r
4237 dsigma = sigma_r - sigma_l
4238 sigma_ref = max(max(abs(sigma_l), abs(sigma_r)), verysmall)
4239
4240 a_l_ref = sqrt(max(verysmall, c%L*c%L + ((4._wp/3._wp)*g_l + tau_nn_l)/rho%L))
4241 a_r_ref = sqrt(max(verysmall, c%R*c%R + ((4._wp/3._wp)*g_r + tau_nn_r)/rho%R))
4242 a_ref = max(max(a_l_ref, a_r_ref), verysmall)
4243
4244 du_t = u_t_r - u_t_l
4245 dtau_nt = tau_nt_r - tau_nt_l
4246 du_t2 = u_t2_r - u_t2_l
4247 dtau_nt2 = tau_nt2_r - tau_nt2_l
4248
4249 sensor_ptot = (dsigma*dsigma)/((adc_kappa*sigma_ref)**2 + verysmall)
4250 sensor_vt = (du_t*du_t + du_t2*du_t2)/((adc_kappa*a_ref)**2 + verysmall)
4251 sensor_tnt = (dtau_nt*dtau_nt + dtau_nt2*dtau_nt2)/((adc_kappa*sigma_ref)**2 + verysmall)
4252
4253 sensor_combined = sensor_ptot + sensor_tnt + sensor_vt
4254
4255 phi = exp(-(sensor_combined**adc_power))
4256 end if
4257 end if
4258
4259 ! Fused dual-pass: both anchored solves share everything above. The anchor (hat) state and everything it
4260 ! touches is evaluated per pass: pass 1 anchors on cell j (hat_L) and writes the flux_rs* set; pass 2
4261 ! anchors on cell j+1 (hat_R) and writes the flux_hatR_rs* set.
4262
4263# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4264#if defined(MFC_OpenACC)
4265# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4266!$acc loop seq
4267# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4268#elif defined(MFC_OpenMP)
4269# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4270
4271# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4272#endif
4273# 485 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4274 do ipass = 1, 2
4275 do i = 1, eqn_idx%cont%end
4276 alpha_rho_hat(i) = q_prim_vf(i)%sf(j, k, l + ipass - 1)
4277# 488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4278 end do
4279 do i = 1, num_fluids
4280 alpha_hat(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l + ipass - 1)
4281# 491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4282 end do
4283
4284# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4285#if defined(MFC_OpenACC)
4286# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4287!$acc loop seq
4288# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4289#elif defined(MFC_OpenMP)
4290# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4291
4292# 492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4293#endif
4294# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4295 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4296 tau_e_hat(i) = q_prim_vf(eqn_idx%stress%beg - 1 + i)%sf(j, k, l + ipass - 1)
4297# 495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4298 end do
4299
4300 ! Anchor-state directional aliases (mirrors the L/R alias block above)
4301 tau_nt2_hat = 0._wp; tau_t2t2_hat = 0._wp; tau_t1t2_hat = 0._wp
4302 tau_nn_hat = tau_e_hat(stress_perm(1))
4303 if (n > 0) then
4304 tau_nt_hat = tau_e_hat(stress_perm(2))
4305 tau_tt_hat = tau_e_hat(stress_perm(3))
4306 if (p > 0) then
4307 tau_nt2_hat = tau_e_hat(stress_perm(4))
4308 tau_t1t2_hat = tau_e_hat(stress_perm(5))
4309 tau_t2t2_hat = tau_e_hat(stress_perm(6))
4310 end if
4311 end if
4312 if (cyl_coord) then
4313 tau_qq_hat = tau_e_hat(eqn_idx%stress%end - eqn_idx%stress%beg + 1)
4314 else
4315 tau_qq_hat = 0._wp
4316 end if
4317
4318 rho_hat = 0._wp
4319
4320# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4321#if defined(MFC_OpenACC)
4322# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4323!$acc loop seq
4324# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4325#elif defined(MFC_OpenMP)
4326# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4327
4328# 516 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4329#endif
4330# 517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4331 do i = 1, num_fluids
4332 rho_hat = rho_hat + alpha_rho_hat(i)
4333 end do
4334
4335 g_hat = 0._wp
4336
4337# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4338#if defined(MFC_OpenACC)
4339# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4340!$acc loop seq
4341# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4342#elif defined(MFC_OpenMP)
4343# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4344
4345# 522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4346#endif
4347# 523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4348 do i = 1, num_fluids
4349 g_hat = g_hat + alpha_hat(i)*gs_rs(i)
4350 end do
4351
4352 ! Two-component 2D only (enforced by checker restrictions)
4353 k_hat = 0._wp
4354 if (alt_soundspeed) then
4355 pres_hat = q_prim_vf(eqn_idx%E)%sf(j, k, l + ipass - 1)
4356# 531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4357 alpha_hat_q = alpha_hat(1)
4358 alpha_rho_hat_q = alpha_rho_hat(1)
4359 call s_phase_bulk_modulus(pres_hat, alpha_hat_q, alpha_rho_hat_q, 1, blkmod1_hat)
4360 alpha_hat_q = alpha_hat(2)
4361 alpha_rho_hat_q = alpha_rho_hat(2)
4362 call s_phase_bulk_modulus(pres_hat, alpha_hat_q, alpha_rho_hat_q, 2, blkmod2_hat)
4363 blkmod1_hat = blkmod1_hat + (4._wp/3._wp)*gs_rs(1)
4364 blkmod2_hat = blkmod2_hat + (4._wp/3._wp)*gs_rs(2)
4365 k_hat = alpha_hat(1)*alpha_hat(2)*(blkmod2_hat - blkmod1_hat)/(alpha_hat(1)*blkmod2_hat &
4366 & + alpha_hat(2)*blkmod1_hat + verysmall)
4367 end if
4368 c_hat_1 = alpha_hat(1) + k_hat
4369 c_hat_2 = alpha_hat(2) - k_hat
4370
4371 if (p > 0 .and. .not. cyl_coord) then
4372 ! 3D Cartesian: anchor-dependent rows (7-14) of the 14-state flux
4373 f_l(7) = u_l(7)*u_n_l - c_hat_1*u_n_l
4374 f_r(7) = u_r(7)*u_n_r - c_hat_1*u_n_r
4375 f_l(8) = u_l(8)*u_n_l - c_hat_2*u_n_l
4376 f_r(8) = u_r(8)*u_n_r - c_hat_2*u_n_r
4377 f_l(9) = u_l(9)*u_n_l - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_l
4378 f_r(9) = u_r(9)*u_n_r - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_r
4379 f_l(10) = u_l(10)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t_l
4380 f_r(10) = u_r(10)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t_r
4381 f_l(11) = u_l(11)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t2_l
4382 f_r(11) = u_r(11)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t2_r
4383 f_l(12) = u_l(12)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_l &
4384 & - 2._wp*rho_hat*tau_nt_hat*u_t_l
4385 f_r(12) = u_r(12)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_r &
4386 & - 2._wp*rho_hat*tau_nt_hat*u_t_r
4387 f_l(13) = u_l(13)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_t2t2_hat)*u_n_l &
4388 & - 2._wp*rho_hat*tau_nt2_hat*u_t2_l
4389 f_r(13) = u_r(13)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_t2t2_hat)*u_n_r &
4390 & - 2._wp*rho_hat*tau_nt2_hat*u_t2_r
4391 f_l(14) = u_l(14)*u_n_l + rho_hat*tau_t1t2_hat*u_n_l - rho_hat*tau_nt2_hat*u_t_l &
4392 & - rho_hat*tau_nt_hat*u_t2_l
4393 f_r(14) = u_r(14)*u_n_r + rho_hat*tau_t1t2_hat*u_n_r - rho_hat*tau_nt2_hat*u_t_r &
4394 & - rho_hat*tau_nt_hat*u_t2_r
4395 else
4396 ! 2D/axisym: anchor-dependent rows (6-11) of the 11-state flux
4397 f_l(6) = u_l(6)*u_n_l - c_hat_1*u_n_l
4398 f_r(6) = u_r(6)*u_n_r - c_hat_1*u_n_r
4399 f_l(7) = u_l(7)*u_n_l - c_hat_2*u_n_l
4400 f_r(7) = u_r(7)*u_n_r - c_hat_2*u_n_r
4401 f_l(8) = u_l(8)*u_n_l - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_l
4402 f_r(8) = u_r(8)*u_n_r - rho_hat*(4._wp/3._wp*g_hat + tau_nn_hat)*u_n_r
4403 f_l(9) = u_l(9)*u_n_l - rho_hat*(g_hat + tau_nn_hat)*u_t_l
4404 f_r(9) = u_r(9)*u_n_r - rho_hat*(g_hat + tau_nn_hat)*u_t_r
4405 f_l(10) = u_l(10)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_l &
4406 & - 2._wp*rho_hat*tau_nt_hat*u_t_l
4407 f_r(10) = u_r(10)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_tt_hat)*u_n_r &
4408 & - 2._wp*rho_hat*tau_nt_hat*u_t_r
4409 f_l(11) = u_l(11)*u_n_l + rho_hat*(2._wp/3._wp*g_hat + tau_qq_hat)*u_n_l
4410 f_r(11) = u_r(11)*u_n_r + rho_hat*(2._wp/3._wp*g_hat + tau_qq_hat)*u_n_r
4411 end if
4412
4413 ! The effective shear stiffness is anchor-dependent. Resolve its three numerical states before
4414 ! forming C_NC: positive keeps HLLD; zero to cancellation accuracy takes the finite HLLC limit;
4415 ! materially negative (loss of the assumed real shear subfan) rejects the whole anchored fan.
4416 ! The tolerance is relative only to the two terms being added, not to an acoustic/material scale.
4417 fan_fallback = degenerate
4418 shear_degenerate = .false.
4419 if (.not. fan_fallback) then
4420 g_eff = g_hat + tau_nn_hat
4421 g_eff_tol = g_eff_roundoff_factor*epsilon(1._wp)*(abs(g_hat) + abs(tau_nn_hat))
4422
4423 if (.not. (g_eff >= -g_eff_tol)) then
4424 ! Materially negative, or unordered (NaN): no real five-wave shear fan.
4425 fan_fallback = .true.
4426 else if (g_eff <= g_eff_tol) then
4427 shear_degenerate = .true.
4428 s_lstar = s_m
4429 s_rstar = s_m
4430 else
4431 c_nc = rho_hat*g_eff
4432 if (.not. (c_nc > 0._wp)) then
4433 ! Positive G_eff below the representable C_NC range is numerically degenerate;
4434 ! nonpositive/unordered rho_hat is invalid for the same construction.
4435 shear_degenerate = (rho_hat > 0._wp)
4436 fan_fallback = .not. shear_degenerate
4437 s_lstar = s_m
4438 s_rstar = s_m
4439 else
4440 sqrtc_nc = sqrt(c_nc)
4441 s_lstar = s_m - sqrtc_nc/rhol_star
4442 s_rstar = s_m + sqrtc_nc/rhor_star
4443 ! A speed-only clamp would break the corresponding Rankine--Hugoniot jump.
4444 fan_fallback = (s_lstar < s_l .or. s_rstar > s_r)
4445 end if
4446 end if
4447 end if
4448
4449 if (fan_fallback) then
4450 ! HLL (or one-sided) fallback for an invalid wave structure
4451 if (s_l < 0._wp .and. s_r > 0._wp) then
4452 do i = 1, ncomp
4453 f_hlld(i) = f_hll_flux(s_l, s_r, f_l(i), f_r(i), u_l(i), u_r(i))
4454 end do
4455 else if (s_l >= 0._wp) then
4456 f_hlld(1:ncomp) = f_l(1:ncomp)
4457 else
4458 f_hlld(1:ncomp) = f_r(1:ncomp)
4459 end if
4460 ! Initialize star-state variables to safe values so no path reads uninitialized memory
4461 ! (a subsequent valid pass restores what it needs). Fallback face exports do not use
4462 ! them: they take the HLL/one-sided traces computed below.
4463 ptot_star = 5e-1_wp*(ptot_l + ptot_r)
4464 s_lstar = s_l
4465 s_rstar = s_r
4466 u_t_star = 5e-1_wp*(u_t_l + u_t_r)
4467 tau_nn_l_star = tau_nn_l
4468 tau_nn_r_star = tau_nn_r
4469 tau_qq_l_star = tau_qq_l
4470 tau_qq_r_star = tau_qq_r
4471 else
4472 ! A preceding anchored pass may have taken the fallback and assigned a safe face value.
4473 ! Restore the anchor-independent HLLD contact pressure for this valid pass.
4474 ptot_star = ptot_l + a_l*(s_m - u_n_l)
4475
4476 if (shear_degenerate) then
4477 ! Degenerate shear impedance: collapse inner waves to HLLC
4478 u_t_star = 5e-1_wp*(u_t_l + u_t_r)
4479 tau_nt_star = 5e-1_wp*(tau_nt_l + tau_nt_r)
4480 u_t2_star = 5e-1_wp*(u_t2_l + u_t2_r)
4481 tau_nt2_star = 5e-1_wp*(tau_nt2_l + tau_nt2_r)
4482 else
4483 u_t_star = 5e-1_wp*((tau_nt_r - tau_nt_l)/sqrtc_nc + (u_t_r + u_t_l))
4484 tau_nt_star = 5e-1_wp*((u_t_r - u_t_l)*sqrtc_nc + (tau_nt_r + tau_nt_l))
4485 u_t2_star = 5e-1_wp*((tau_nt2_r - tau_nt2_l)/sqrtc_nc + (u_t2_r + u_t2_l))
4486 tau_nt2_star = 5e-1_wp*((u_t2_r - u_t2_l)*sqrtc_nc + (tau_nt2_r + tau_nt2_l))
4487 end if
4488
4489 ! Outer-wave stress star states: one formula family over the components. ELC is
4490 ! the anchor-side elastic coefficient (deviatoric 4/3 vs 2/3 structure; t1t2
4491 ! carries no G term) and SGN = -1/+1 the jump sign of the component.
4492# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4493# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4494 tau_nn_l_star = tau_nn_l - (rho_hat*(g_hat*4._wp/3._wp + tau_nn_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
4495# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4496# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4497 tau_nn_r_star = tau_nn_r - (rho_hat*(g_hat*4._wp/3._wp + tau_nn_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
4498# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4499# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4500# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4501# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4502 tau_tt_l_star = tau_tt_l + (rho_hat*(g_hat*2._wp/3._wp + tau_tt_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
4503# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4504# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4505 tau_tt_r_star = tau_tt_r + (rho_hat*(g_hat*2._wp/3._wp + tau_tt_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
4506# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4507# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4508# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4509# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4510 tau_t2t2_l_star = tau_t2t2_l + (rho_hat*(g_hat*2._wp/3._wp + tau_t2t2_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
4511# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4512# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4513 tau_t2t2_r_star = tau_t2t2_r + (rho_hat*(g_hat*2._wp/3._wp + tau_t2t2_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
4514# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4515# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4516# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4517# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4518 tau_t1t2_l_star = tau_t1t2_l + (rho_hat*tau_t1t2_hat*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
4519# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4520# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4521 tau_t1t2_r_star = tau_t1t2_r + (rho_hat*tau_t1t2_hat*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
4522# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4523# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4524# 671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4525# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4526 tau_qq_l_star = tau_qq_l + (rho_hat*(g_hat*2._wp/3._wp + tau_qq_hat)*(u_n_l - s_m))/(rho%L*(u_n_l - s_l))
4527# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4528# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4529 tau_qq_r_star = tau_qq_r + (rho_hat*(g_hat*2._wp/3._wp + tau_qq_hat)*(u_n_r - s_m))/(rho%R*(u_n_r - s_r))
4530# 673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4531# 674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4532# 675 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4533
4534 if (shear_degenerate) then
4535 ! Degenerate: no inner wave correction
4536 tau_tt_l_starstar = tau_tt_l_star
4537 tau_tt_r_starstar = tau_tt_r_star
4538 tau_t2t2_l_starstar = tau_t2t2_l_star
4539 tau_t2t2_r_starstar = tau_t2t2_r_star
4540 tau_t1t2_l_starstar = tau_t1t2_l_star
4541 tau_t1t2_r_starstar = tau_t1t2_r_star
4542 e_l_starstar = e_l_star
4543 e_r_starstar = e_r_star
4544 else
4545 tau_tt_l_starstar = tau_tt_l_star + 2._wp*rho_hat*tau_nt_hat/sqrtc_nc*(u_t_star - u_t_l)
4546 tau_tt_r_starstar = tau_tt_r_star - 2._wp*rho_hat*tau_nt_hat/sqrtc_nc*(u_t_star - u_t_r)
4547 tau_t2t2_l_starstar = tau_t2t2_l_star + 2._wp*rho_hat*tau_nt2_hat/sqrtc_nc*(u_t2_star &
4548 & - u_t2_l)
4549 tau_t2t2_r_starstar = tau_t2t2_r_star - 2._wp*rho_hat*tau_nt2_hat/sqrtc_nc*(u_t2_star &
4550 & - u_t2_r)
4551 tau_t1t2_l_starstar = tau_t1t2_l_star + rho_hat*(tau_nt2_hat*(u_t_star - u_t_l) &
4552 & + tau_nt_hat*(u_t2_star - u_t2_l))/sqrtc_nc
4553 tau_t1t2_r_starstar = tau_t1t2_r_star - rho_hat*(tau_nt2_hat*(u_t_star - u_t_r) &
4554 & + tau_nt_hat*(u_t2_star - u_t2_r))/sqrtc_nc
4555 e_l_starstar = e_l_star + (rhol_star/sqrtc_nc)*((u_t_star*tau_nt_star - u_t_l*tau_nt_l) &
4556 & + (u_t2_star*tau_nt2_star - u_t2_l*tau_nt2_l))
4557 e_r_starstar = e_r_star - (rhor_star/sqrtc_nc)*((u_t_star*tau_nt_star - u_t_r*tau_nt_r) &
4558 & + (u_t2_star*tau_nt2_star - u_t2_r*tau_nt2_r))
4559 end if
4560
4561 alpha1_l_star = (alpha_l(1)*(s_l - u_n_l) - c_hat_1*(s_m - u_n_l))/min(s_l - s_m, -verysmall)
4562 alpha1_r_star = (alpha_r(1)*(s_r - u_n_r) - c_hat_1*(s_m - u_n_r))/max(s_r - s_m, verysmall)
4563
4564 alpha2_l_star = (alpha_l(2)*(s_l - u_n_l) - c_hat_2*(s_m - u_n_l))/min(s_l - s_m, -verysmall)
4565 alpha2_r_star = (alpha_r(2)*(s_r - u_n_r) - c_hat_2*(s_m - u_n_r))/max(s_r - s_m, verysmall)
4566
4567 ! HLLD flux, register-diet form: pick the wave-fan zone once (it is
4568 ! component-independent), then fold the selected side's star/starstar states into
4569 ! F_hlld one component at a time through the scalars us_c/uss_c (no fan arrays
4570 ! survive). The L and R sides are mirror images and the per-component statements
4571 ! share one shape, so the whole fold is emitted from one Fypp template driven by
4572 ! HLLD_FAN_SIDES and the HLLD_FAN_COMPS_3D/2D tables above. Per-component operation
4573 ! order matches the materialized form, so the flux is -O0 bit-identical. Do NOT
4574 ! re-expand into per-region temp arrays (or reorder the fold) without re-checking
4575 ! GPU register spill and the -O0 exactness gate.
4576
4577 zone = f_hlld_wave_zone(s_l, s_lstar, s_m, s_rstar, s_r)
4578
4579 if (zone == 0) then
4580 f_hlld(1:ncomp) = f_l(1:ncomp)
4581 else if (zone == 5) then
4582 f_hlld(1:ncomp) = f_r(1:ncomp)
4583# 726 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4584 else if (zone == 1 .or. zone == 2) then
4585# 727 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4586 ! L side of the fan: per component, us_c/uss_c are the selected side's
4587# 728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4588 ! star/starstar states (the old F_starL is folded into the first F_hlld
4589# 729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4590 ! statement; the starstar correction applies in zone 2 only, with the
4591# 730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4592 ! left-associative order of the materialized form preserved)
4593 if (p > 0 .and. .not. cyl_coord) then
4594# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4595 us_c = u_l(1)*fac_l
4596# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4597 uss_c = us_c
4598# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4599 f_hlld(1) = f_l(1) + s_l*(us_c - u_l(1))
4600# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4601 if (zone == 2) f_hlld(1) = f_hlld(1) + s_lstar*(uss_c &
4602# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4603 & - us_c)
4604# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4605 us_c = u_l(2)*fac_l
4606# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4607 uss_c = us_c
4608# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4609 f_hlld(2) = f_l(2) + s_l*(us_c - u_l(2))
4610# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4611 if (zone == 2) f_hlld(2) = f_hlld(2) + s_lstar*(uss_c &
4612# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4613 & - us_c)
4614# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4615 us_c = rhol_star*s_m
4616# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4617 uss_c = us_c
4618# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4619 f_hlld(3) = f_l(3) + s_l*(us_c - u_l(3))
4620# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4621 if (zone == 2) f_hlld(3) = f_hlld(3) + s_lstar*(uss_c &
4622# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4623 & - us_c)
4624# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4625 us_c = rhol_star*u_t_l
4626# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4627 uss_c = rhol_star*u_t_star
4628# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4629 f_hlld(4) = f_l(4) + s_l*(us_c - u_l(4))
4630# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4631 if (zone == 2) f_hlld(4) = f_hlld(4) + s_lstar*(uss_c &
4632# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4633 & - us_c)
4634# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4635 us_c = rhol_star*u_t2_l
4636# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4637 uss_c = rhol_star*u_t2_star
4638# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4639 f_hlld(5) = f_l(5) + s_l*(us_c - u_l(5))
4640# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4641 if (zone == 2) f_hlld(5) = f_hlld(5) + s_lstar*(uss_c &
4642# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4643 & - us_c)
4644# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4645 us_c = e_l_star
4646# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4647 uss_c = e_l_starstar
4648# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4649 f_hlld(6) = f_l(6) + s_l*(us_c - u_l(6))
4650# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4651 if (zone == 2) f_hlld(6) = f_hlld(6) + s_lstar*(uss_c &
4652# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4653 & - us_c)
4654# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4655 us_c = alpha1_l_star
4656# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4657 uss_c = us_c
4658# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4659 f_hlld(7) = f_l(7) + s_l*(us_c - u_l(7))
4660# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4661 if (zone == 2) f_hlld(7) = f_hlld(7) + s_lstar*(uss_c &
4662# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4663 & - us_c)
4664# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4665 us_c = alpha2_l_star
4666# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4667 uss_c = us_c
4668# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4669 f_hlld(8) = f_l(8) + s_l*(us_c - u_l(8))
4670# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4671 if (zone == 2) f_hlld(8) = f_hlld(8) + s_lstar*(uss_c &
4672# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4673 & - us_c)
4674# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4675 us_c = rhol_star*tau_nn_l_star
4676# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4677 uss_c = us_c
4678# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4679 f_hlld(9) = f_l(9) + s_l*(us_c - u_l(9))
4680# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4681 if (zone == 2) f_hlld(9) = f_hlld(9) + s_lstar*(uss_c &
4682# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4683 & - us_c)
4684# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4685 us_c = rhol_star*tau_nt_l
4686# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4687 uss_c = rhol_star*tau_nt_star
4688# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4689 f_hlld(10) = f_l(10) + s_l*(us_c - u_l(10))
4690# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4691 if (zone == 2) f_hlld(10) = f_hlld(10) + s_lstar*(uss_c &
4692# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4693 & - us_c)
4694# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4695 us_c = rhol_star*tau_nt2_l
4696# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4697 uss_c = rhol_star*tau_nt2_star
4698# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4699 f_hlld(11) = f_l(11) + s_l*(us_c - u_l(11))
4700# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4701 if (zone == 2) f_hlld(11) = f_hlld(11) + s_lstar*(uss_c &
4702# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4703 & - us_c)
4704# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4705 us_c = rhol_star*tau_tt_l_star
4706# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4707 uss_c = rhol_star*tau_tt_l_starstar
4708# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4709 f_hlld(12) = f_l(12) + s_l*(us_c - u_l(12))
4710# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4711 if (zone == 2) f_hlld(12) = f_hlld(12) + s_lstar*(uss_c &
4712# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4713 & - us_c)
4714# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4715 us_c = rhol_star*tau_t2t2_l_star
4716# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4717 uss_c = rhol_star*tau_t2t2_l_starstar
4718# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4719 f_hlld(13) = f_l(13) + s_l*(us_c - u_l(13))
4720# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4721 if (zone == 2) f_hlld(13) = f_hlld(13) + s_lstar*(uss_c &
4722# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4723 & - us_c)
4724# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4725 us_c = rhol_star*tau_t1t2_l_star
4726# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4727 uss_c = rhol_star*tau_t1t2_l_starstar
4728# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4729 f_hlld(14) = f_l(14) + s_l*(us_c - u_l(14))
4730# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4731 if (zone == 2) f_hlld(14) = f_hlld(14) + s_lstar*(uss_c &
4732# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4733 & - us_c)
4734# 739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4735 else
4736# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4737 us_c = u_l(1)*fac_l
4738# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4739 uss_c = us_c
4740# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4741 f_hlld(1) = f_l(1) + s_l*(us_c - u_l(1))
4742# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4743 if (zone == 2) f_hlld(1) = f_hlld(1) + s_lstar*(uss_c &
4744# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4745 & - us_c)
4746# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4747 us_c = u_l(2)*fac_l
4748# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4749 uss_c = us_c
4750# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4751 f_hlld(2) = f_l(2) + s_l*(us_c - u_l(2))
4752# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4753 if (zone == 2) f_hlld(2) = f_hlld(2) + s_lstar*(uss_c &
4754# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4755 & - us_c)
4756# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4757 us_c = rhol_star*s_m
4758# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4759 uss_c = us_c
4760# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4761 f_hlld(3) = f_l(3) + s_l*(us_c - u_l(3))
4762# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4763 if (zone == 2) f_hlld(3) = f_hlld(3) + s_lstar*(uss_c &
4764# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4765 & - us_c)
4766# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4767 us_c = rhol_star*u_t_l
4768# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4769 uss_c = rhol_star*u_t_star
4770# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4771 f_hlld(4) = f_l(4) + s_l*(us_c - u_l(4))
4772# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4773 if (zone == 2) f_hlld(4) = f_hlld(4) + s_lstar*(uss_c &
4774# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4775 & - us_c)
4776# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4777 us_c = e_l_star
4778# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4779 uss_c = e_l_starstar
4780# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4781 f_hlld(5) = f_l(5) + s_l*(us_c - u_l(5))
4782# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4783 if (zone == 2) f_hlld(5) = f_hlld(5) + s_lstar*(uss_c &
4784# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4785 & - us_c)
4786# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4787 us_c = alpha1_l_star
4788# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4789 uss_c = us_c
4790# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4791 f_hlld(6) = f_l(6) + s_l*(us_c - u_l(6))
4792# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4793 if (zone == 2) f_hlld(6) = f_hlld(6) + s_lstar*(uss_c &
4794# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4795 & - us_c)
4796# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4797 us_c = alpha2_l_star
4798# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4799 uss_c = us_c
4800# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4801 f_hlld(7) = f_l(7) + s_l*(us_c - u_l(7))
4802# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4803 if (zone == 2) f_hlld(7) = f_hlld(7) + s_lstar*(uss_c &
4804# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4805 & - us_c)
4806# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4807 us_c = rhol_star*tau_nn_l_star
4808# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4809 uss_c = us_c
4810# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4811 f_hlld(8) = f_l(8) + s_l*(us_c - u_l(8))
4812# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4813 if (zone == 2) f_hlld(8) = f_hlld(8) + s_lstar*(uss_c &
4814# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4815 & - us_c)
4816# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4817 us_c = rhol_star*tau_nt_l
4818# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4819 uss_c = rhol_star*tau_nt_star
4820# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4821 f_hlld(9) = f_l(9) + s_l*(us_c - u_l(9))
4822# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4823 if (zone == 2) f_hlld(9) = f_hlld(9) + s_lstar*(uss_c &
4824# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4825 & - us_c)
4826# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4827 us_c = rhol_star*tau_tt_l_star
4828# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4829 uss_c = rhol_star*tau_tt_l_starstar
4830# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4831 f_hlld(10) = f_l(10) + s_l*(us_c - u_l(10))
4832# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4833 if (zone == 2) f_hlld(10) = f_hlld(10) + s_lstar*(uss_c &
4834# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4835 & - us_c)
4836# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4837 us_c = rhol_star*tau_qq_l_star
4838# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4839 uss_c = us_c
4840# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4841 f_hlld(11) = f_l(11) + s_l*(us_c - u_l(11))
4842# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4843 if (zone == 2) f_hlld(11) = f_hlld(11) + s_lstar*(uss_c &
4844# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4845 & - us_c)
4846# 747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4847 end if
4848# 726 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4849 else if (zone == 3 .or. zone == 4) then
4850# 727 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4851 ! R side of the fan: per component, us_c/uss_c are the selected side's
4852# 728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4853 ! star/starstar states (the old F_starR is folded into the first F_hlld
4854# 729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4855 ! statement; the starstar correction applies in zone 3 only, with the
4856# 730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4857 ! left-associative order of the materialized form preserved)
4858 if (p > 0 .and. .not. cyl_coord) then
4859# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4860 us_c = u_r(1)*fac_r
4861# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4862 uss_c = us_c
4863# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4864 f_hlld(1) = f_r(1) + s_r*(us_c - u_r(1))
4865# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4866 if (zone == 3) f_hlld(1) = f_hlld(1) + s_rstar*(uss_c &
4867# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4868 & - us_c)
4869# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4870 us_c = u_r(2)*fac_r
4871# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4872 uss_c = us_c
4873# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4874 f_hlld(2) = f_r(2) + s_r*(us_c - u_r(2))
4875# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4876 if (zone == 3) f_hlld(2) = f_hlld(2) + s_rstar*(uss_c &
4877# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4878 & - us_c)
4879# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4880 us_c = rhor_star*s_m
4881# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4882 uss_c = us_c
4883# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4884 f_hlld(3) = f_r(3) + s_r*(us_c - u_r(3))
4885# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4886 if (zone == 3) f_hlld(3) = f_hlld(3) + s_rstar*(uss_c &
4887# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4888 & - us_c)
4889# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4890 us_c = rhor_star*u_t_r
4891# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4892 uss_c = rhor_star*u_t_star
4893# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4894 f_hlld(4) = f_r(4) + s_r*(us_c - u_r(4))
4895# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4896 if (zone == 3) f_hlld(4) = f_hlld(4) + s_rstar*(uss_c &
4897# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4898 & - us_c)
4899# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4900 us_c = rhor_star*u_t2_r
4901# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4902 uss_c = rhor_star*u_t2_star
4903# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4904 f_hlld(5) = f_r(5) + s_r*(us_c - u_r(5))
4905# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4906 if (zone == 3) f_hlld(5) = f_hlld(5) + s_rstar*(uss_c &
4907# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4908 & - us_c)
4909# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4910 us_c = e_r_star
4911# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4912 uss_c = e_r_starstar
4913# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4914 f_hlld(6) = f_r(6) + s_r*(us_c - u_r(6))
4915# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4916 if (zone == 3) f_hlld(6) = f_hlld(6) + s_rstar*(uss_c &
4917# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4918 & - us_c)
4919# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4920 us_c = alpha1_r_star
4921# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4922 uss_c = us_c
4923# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4924 f_hlld(7) = f_r(7) + s_r*(us_c - u_r(7))
4925# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4926 if (zone == 3) f_hlld(7) = f_hlld(7) + s_rstar*(uss_c &
4927# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4928 & - us_c)
4929# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4930 us_c = alpha2_r_star
4931# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4932 uss_c = us_c
4933# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4934 f_hlld(8) = f_r(8) + s_r*(us_c - u_r(8))
4935# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4936 if (zone == 3) f_hlld(8) = f_hlld(8) + s_rstar*(uss_c &
4937# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4938 & - us_c)
4939# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4940 us_c = rhor_star*tau_nn_r_star
4941# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4942 uss_c = us_c
4943# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4944 f_hlld(9) = f_r(9) + s_r*(us_c - u_r(9))
4945# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4946 if (zone == 3) f_hlld(9) = f_hlld(9) + s_rstar*(uss_c &
4947# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4948 & - us_c)
4949# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4950 us_c = rhor_star*tau_nt_r
4951# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4952 uss_c = rhor_star*tau_nt_star
4953# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4954 f_hlld(10) = f_r(10) + s_r*(us_c - u_r(10))
4955# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4956 if (zone == 3) f_hlld(10) = f_hlld(10) + s_rstar*(uss_c &
4957# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4958 & - us_c)
4959# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4960 us_c = rhor_star*tau_nt2_r
4961# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4962 uss_c = rhor_star*tau_nt2_star
4963# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4964 f_hlld(11) = f_r(11) + s_r*(us_c - u_r(11))
4965# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4966 if (zone == 3) f_hlld(11) = f_hlld(11) + s_rstar*(uss_c &
4967# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4968 & - us_c)
4969# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4970 us_c = rhor_star*tau_tt_r_star
4971# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4972 uss_c = rhor_star*tau_tt_r_starstar
4973# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4974 f_hlld(12) = f_r(12) + s_r*(us_c - u_r(12))
4975# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4976 if (zone == 3) f_hlld(12) = f_hlld(12) + s_rstar*(uss_c &
4977# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4978 & - us_c)
4979# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4980 us_c = rhor_star*tau_t2t2_r_star
4981# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4982 uss_c = rhor_star*tau_t2t2_r_starstar
4983# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4984 f_hlld(13) = f_r(13) + s_r*(us_c - u_r(13))
4985# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4986 if (zone == 3) f_hlld(13) = f_hlld(13) + s_rstar*(uss_c &
4987# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4988 & - us_c)
4989# 733 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4990 us_c = rhor_star*tau_t1t2_r_star
4991# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4992 uss_c = rhor_star*tau_t1t2_r_starstar
4993# 735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4994 f_hlld(14) = f_r(14) + s_r*(us_c - u_r(14))
4995# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4996 if (zone == 3) f_hlld(14) = f_hlld(14) + s_rstar*(uss_c &
4997# 737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
4998 & - us_c)
4999# 739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5000 else
5001# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5002 us_c = u_r(1)*fac_r
5003# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5004 uss_c = us_c
5005# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5006 f_hlld(1) = f_r(1) + s_r*(us_c - u_r(1))
5007# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5008 if (zone == 3) f_hlld(1) = f_hlld(1) + s_rstar*(uss_c &
5009# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5010 & - us_c)
5011# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5012 us_c = u_r(2)*fac_r
5013# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5014 uss_c = us_c
5015# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5016 f_hlld(2) = f_r(2) + s_r*(us_c - u_r(2))
5017# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5018 if (zone == 3) f_hlld(2) = f_hlld(2) + s_rstar*(uss_c &
5019# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5020 & - us_c)
5021# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5022 us_c = rhor_star*s_m
5023# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5024 uss_c = us_c
5025# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5026 f_hlld(3) = f_r(3) + s_r*(us_c - u_r(3))
5027# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5028 if (zone == 3) f_hlld(3) = f_hlld(3) + s_rstar*(uss_c &
5029# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5030 & - us_c)
5031# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5032 us_c = rhor_star*u_t_r
5033# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5034 uss_c = rhor_star*u_t_star
5035# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5036 f_hlld(4) = f_r(4) + s_r*(us_c - u_r(4))
5037# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5038 if (zone == 3) f_hlld(4) = f_hlld(4) + s_rstar*(uss_c &
5039# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5040 & - us_c)
5041# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5042 us_c = e_r_star
5043# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5044 uss_c = e_r_starstar
5045# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5046 f_hlld(5) = f_r(5) + s_r*(us_c - u_r(5))
5047# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5048 if (zone == 3) f_hlld(5) = f_hlld(5) + s_rstar*(uss_c &
5049# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5050 & - us_c)
5051# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5052 us_c = alpha1_r_star
5053# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5054 uss_c = us_c
5055# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5056 f_hlld(6) = f_r(6) + s_r*(us_c - u_r(6))
5057# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5058 if (zone == 3) f_hlld(6) = f_hlld(6) + s_rstar*(uss_c &
5059# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5060 & - us_c)
5061# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5062 us_c = alpha2_r_star
5063# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5064 uss_c = us_c
5065# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5066 f_hlld(7) = f_r(7) + s_r*(us_c - u_r(7))
5067# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5068 if (zone == 3) f_hlld(7) = f_hlld(7) + s_rstar*(uss_c &
5069# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5070 & - us_c)
5071# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5072 us_c = rhor_star*tau_nn_r_star
5073# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5074 uss_c = us_c
5075# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5076 f_hlld(8) = f_r(8) + s_r*(us_c - u_r(8))
5077# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5078 if (zone == 3) f_hlld(8) = f_hlld(8) + s_rstar*(uss_c &
5079# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5080 & - us_c)
5081# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5082 us_c = rhor_star*tau_nt_r
5083# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5084 uss_c = rhor_star*tau_nt_star
5085# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5086 f_hlld(9) = f_r(9) + s_r*(us_c - u_r(9))
5087# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5088 if (zone == 3) f_hlld(9) = f_hlld(9) + s_rstar*(uss_c &
5089# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5090 & - us_c)
5091# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5092 us_c = rhor_star*tau_tt_r_star
5093# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5094 uss_c = rhor_star*tau_tt_r_starstar
5095# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5096 f_hlld(10) = f_r(10) + s_r*(us_c - u_r(10))
5097# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5098 if (zone == 3) f_hlld(10) = f_hlld(10) + s_rstar*(uss_c &
5099# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5100 & - us_c)
5101# 741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5102 us_c = rhor_star*tau_qq_r_star
5103# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5104 uss_c = us_c
5105# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5106 f_hlld(11) = f_r(11) + s_r*(us_c - u_r(11))
5107# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5108 if (zone == 3) f_hlld(11) = f_hlld(11) + s_rstar*(uss_c &
5109# 745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5110 & - us_c)
5111# 747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5112 end if
5113# 749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5114 end if
5115
5116 ! ADC blending (HLLD / HLL)
5117
5118 if (riemann_hypo_adc) then
5119 ! Register-diet form: the HLL flux enters per component as the scalar F_HLL_c
5120 ! instead of a materialized F_HLL array; outside the subsonic fan F_HLL equals
5121 ! F_hlld and the identity blend is kept explicitly so the arithmetic (including
5122 ! signed-zero behavior) matches the array form bit-for-bit.
5123 ! phi is anchor-independent: computed once in the shared section above
5124 if (s_l < 0._wp .and. s_r > 0._wp) then
5125 do i = 1, ncomp
5126 f_hll_c = f_hll_flux(s_l, s_r, f_l(i), f_r(i), u_l(i), u_r(i))
5127 f_hlld(i) = f_hll_c + phi*(f_hlld(i) - f_hll_c)
5128 end do
5129 else
5130 do i = 1, ncomp
5131 f_hll_c = f_hlld(i)
5132 f_hlld(i) = f_hll_c + phi*(f_hlld(i) - f_hll_c)
5133 end do
5134 end if
5135 end if
5136 end if
5137
5138 ! HLL face traces for the axisymmetric completion: consumed by the ADC face-state blend on
5139 ! valid fans and by the face exports on fallback faces (whose conservative flux is the
5140 ! matching HLL/one-sided flux). Rows 8/11 carry the pass's anchored folds, so the traces
5141 ! are anchor-dependent, like the ADC reference they generalize.
5142 if (cyl_coord .and. (riemann_hypo_adc .or. fan_fallback)) then
5143 if (0._wp <= s_l) then
5144 u_n_hll_trace = u_n_l; u_t_hll_trace = u_t_l
5145 p_face_hll = pres%L; tau_qq_face_hll = tau_qq_l
5146 else if (s_r <= 0._wp) then
5147 u_n_hll_trace = u_n_r; u_t_hll_trace = u_t_r
5148 p_face_hll = pres%R; tau_qq_face_hll = tau_qq_r
5149 else
5150 u_n_hll_trace = (s_r*u_n_l - s_l*u_n_r)/(s_r - s_l + verysmall)
5151 u_t_hll_trace = (s_r*u_t_l - s_l*u_t_r)/(s_r - s_l + verysmall)
5152 ! Only HLL-state components 1, 2, 3, 8 and 11 feed the axisym trace
5153 u_hll_c = (s_r*u_r(1) - s_l*u_l(1) - (f_r(1) - f_l(1)))/(s_r - s_l + verysmall)
5154 rho_hll = u_hll_c
5155 u_hll_c = (s_r*u_r(2) - s_l*u_l(2) - (f_r(2) - f_l(2)))/(s_r - s_l + verysmall)
5156 rho_hll = rho_hll + u_hll_c
5157 u_hll_c = (s_r*u_r(3) - s_l*u_l(3) - (f_r(3) - f_l(3)))/(s_r - s_l + verysmall)
5158 u_n_hll_cons = u_hll_c/(rho_hll + verysmall)
5159 u_hll_c = (s_r*u_r(8) - s_l*u_l(8) - (f_r(8) - f_l(8)))/(s_r - s_l + verysmall)
5160 tau_nn_hll = u_hll_c/(rho_hll + verysmall)
5161 u_hll_c = (s_r*u_r(11) - s_l*u_l(11) - (f_r(11) - f_l(11)))/(s_r - s_l + verysmall)
5162 tau_qq_face_hll = u_hll_c/(rho_hll + verysmall)
5163 ! This branch implies S_L < 0 < S_R, so component 3 of F_HLL is the interior HLL flux
5164 f_hll_c = f_hll_flux(s_l, s_r, f_l(3), f_r(3), u_l(3), u_r(3))
5165 p_face_hll = f_hll_c - rho_hll*u_n_hll_cons*u_n_hll_cons + tau_nn_hll
5166 end if
5167 end if
5168
5169 ! Reorder F_HLLD for output: pass 1 (hat_L) -> flux_rs*, pass 2 (hat_R) -> flux_hatR_rs*
5170# 806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5171 if (ipass == 1) then
5172# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5173 if (p > 0 .and. .not. cyl_coord) then
5174 ! 3D Cartesian: 14-state -> physical indices
5175 flux_rsx_vf(j, k, l, 1) = f_hlld(1)
5176# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5177 flux_rsx_vf(j, k, l, 2) = f_hlld(2)
5178# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5179 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
5180# 812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5181 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
5182# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5183 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(5)
5184# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5185 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(6)
5186# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5187 flux_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(7)
5188# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5189 flux_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(8)
5190# 817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5191 ! Map local stress to physical stress indices
5192 if (dir_idx(1) == 1) then
5193 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(9) ! tau_nn=tau_xx
5194# 820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5195 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
5196# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5197 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(12) ! tau_t1t1=tau_yy
5198# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5199 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(11) ! tau_nt2=tau_xz
5200# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5201 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(14) ! tau_t1t2=tau_yz
5202# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5203 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
5204# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5205 else if (dir_idx(1) == 2) then
5206 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
5207# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5208 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
5209# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5210 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(9) ! tau_nn=tau_yy
5211# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5212 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(14) ! tau_t1t2=tau_xz
5213# 830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5214 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
5215# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5216 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
5217# 832 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5218 else
5219 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
5220# 834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5221 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(14) ! tau_t1t2=tau_xy
5222# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5223 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(13) ! tau_t2t2=tau_yy
5224# 836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5225 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(10) ! tau_nt1=tau_xz
5226# 837 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5227 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
5228# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5229 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(9) ! tau_nn=tau_zz
5230# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5231 end if
5232 else
5233 ! 2D/axisym: 11-state (unchanged)
5234 flux_rsx_vf(j, k, l, 1) = f_hlld(1)
5235# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5236 flux_rsx_vf(j, k, l, 2) = f_hlld(2)
5237# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5238 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
5239# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5240 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
5241# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5242 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(5)
5243# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5244 flux_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(6)
5245# 848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5246 flux_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(7)
5247# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5248 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(9)
5249# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5250 if (dir_idx(1) == 1) then
5251 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(8)
5252# 852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5253 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(10)
5254# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5255 else
5256 flux_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(10)
5257# 855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5258 flux_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(8)
5259# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5260 end if
5261 if (cyl_coord) then
5262 flux_rsx_vf(j, k, l, eqn_idx%stress%end) = f_hlld(11)
5263# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5264 end if
5265 end if
5266 end if
5267# 806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5268 if (ipass == 2) then
5269# 807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5270 if (p > 0 .and. .not. cyl_coord) then
5271 ! 3D Cartesian: 14-state -> physical indices
5272 flux_hatr_rsx_vf(j, k, l, 1) = f_hlld(1)
5273# 810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5274 flux_hatr_rsx_vf(j, k, l, 2) = f_hlld(2)
5275# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5276 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
5277# 812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5278 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
5279# 813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5280 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(5)
5281# 814 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5282 flux_hatr_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(6)
5283# 815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5284 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(7)
5285# 816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5286 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(8)
5287# 817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5288 ! Map local stress to physical stress indices
5289 if (dir_idx(1) == 1) then
5290 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(9) ! tau_nn=tau_xx
5291# 820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5292 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
5293# 821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5294 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(12) ! tau_t1t1=tau_yy
5295# 822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5296 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(11) ! tau_nt2=tau_xz
5297# 823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5298 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(14) ! tau_t1t2=tau_yz
5299# 824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5300 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
5301# 825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5302 else if (dir_idx(1) == 2) then
5303 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
5304# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5305 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(10) ! tau_nt1=tau_xy
5306# 828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5307 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(9) ! tau_nn=tau_yy
5308# 829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5309 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(14) ! tau_t1t2=tau_xz
5310# 830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5311 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
5312# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5313 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(13) ! tau_t2t2=tau_zz
5314# 832 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5315 else
5316 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(12) ! tau_t1t1=tau_xx
5317# 834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5318 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(14) ! tau_t1t2=tau_xy
5319# 835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5320 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(13) ! tau_t2t2=tau_yy
5321# 836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5322 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 3) = f_hlld(10) ! tau_nt1=tau_xz
5323# 837 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5324 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 4) = f_hlld(11) ! tau_nt2=tau_yz
5325# 838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5326 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 5) = f_hlld(9) ! tau_nn=tau_zz
5327# 839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5328 end if
5329 else
5330 ! 2D/axisym: 11-state (unchanged)
5331 flux_hatr_rsx_vf(j, k, l, 1) = f_hlld(1)
5332# 843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5333 flux_hatr_rsx_vf(j, k, l, 2) = f_hlld(2)
5334# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5335 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(3)
5336# 845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5337 flux_hatr_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(4)
5338# 846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5339 flux_hatr_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(5)
5340# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5341 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 1) = f_hlld(6)
5342# 848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5343 flux_hatr_rsx_vf(j, k, l, eqn_idx%E + 2) = f_hlld(7)
5344# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5345 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 1) = f_hlld(9)
5346# 850 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5347 if (dir_idx(1) == 1) then
5348 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(8)
5349# 852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5350 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(10)
5351# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5352 else
5353 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg) = f_hlld(10)
5354# 855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5355 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%beg + 2) = f_hlld(8)
5356# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5357 end if
5358 if (cyl_coord) then
5359 flux_hatr_rsx_vf(j, k, l, eqn_idx%stress%end) = f_hlld(11)
5360# 859 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5361 end if
5362 end if
5363 end if
5364# 863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5365
5366 ! Export face velocities for axisym hypo source terms
5367 if (grid_geometry == 2) then
5368 if (fan_fallback) then
5369 ! Fallback face: the conservative flux is the HLL/one-sided flux, so export the
5370 ! matching HLL/one-sided traces, not the rejected fan's contact speed/star states
5371 u_n_face = u_n_hll_trace; u_t_face = u_t_hll_trace
5372 else
5373 ! Upwind by wave-fan wedge: the inner zones ride the contact (u_n = S_M) and the
5374 ! tangential state switches L -> star -> R across the shear waves (zones 2 and 3
5375 ! share the tangential star state)
5376 if (zone == 0) then
5377 u_n_face = u_n_l; u_t_face = u_t_l
5378 else if (zone == 1) then
5379 u_n_face = s_m; u_t_face = u_t_l
5380 else if (zone <= 3) then
5381 u_n_face = s_m; u_t_face = u_t_star
5382 else if (zone == 4) then
5383 u_n_face = s_m; u_t_face = u_t_r
5384 else
5385 u_n_face = u_n_r; u_t_face = u_t_r
5386 end if
5387 ! ADC blend NC face velocities with HLL scalar traces (valid fans; a fallback
5388 ! face already exports the pure HLL traces)
5389 if (riemann_hypo_adc) then
5390 u_n_face = u_n_hll_trace + phi*(u_n_face - u_n_hll_trace)
5391 u_t_face = u_t_hll_trace + phi*(u_t_face - u_t_hll_trace)
5392 end if
5393 end if
5394# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5395 if (ipass == 1) then
5396# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5397 if (dir_idx(1) == 1) then
5398 nc_iface_vel_rsx_vf(j, k, l, 1) = u_n_face
5399# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5400 nc_iface_vel_rsx_vf(j, k, l, 2) = u_t_face
5401# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5402 else
5403 nc_iface_vel_rsx_vf(j, k, l, 1) = u_t_face
5404# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5405 nc_iface_vel_rsx_vf(j, k, l, 2) = u_n_face
5406# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5407 end if
5408 end if
5409# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5410 if (ipass == 2) then
5411# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5412 if (dir_idx(1) == 1) then
5413 nc_iface_vel_hatr_rsx_vf(j, k, l, 1) = u_n_face
5414# 896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5415 nc_iface_vel_hatr_rsx_vf(j, k, l, 2) = u_t_face
5416# 897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5417 else
5418 nc_iface_vel_hatr_rsx_vf(j, k, l, 1) = u_t_face
5419# 899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5420 nc_iface_vel_hatr_rsx_vf(j, k, l, 2) = u_n_face
5421# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5422 end if
5423 end if
5424# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5425 end if
5426
5427 ! Radial geometric source flux for cylindrical coordinates. Only genuinely conservative rows
5428 ! (masses, momenta, energy) carry a numerical geometric flux: their full radial flux IS the
5429 ! -H/r metric quantity. The volume-fraction and stress rows are zeroed: the augmented stress
5430 ! fluxes fold constitutive velocity terms that must not be divided by r; their complete
5431 ! cylindrical completion is the cell-local dual-pass source
5432 ! (s_compute_hypoelastic_rhs_axisym_geom_dual_pass).
5433# 954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5434 end do
5435
5436 ! Dual-pass HLLD: all NC terms stay inside the Riemann flux (anchor-independent; written once)
5437 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
5438# 958 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5439 end do
5440 end do
5441 end do
5442
5443# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5444#if defined(MFC_OpenACC)
5445# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5446!$acc end parallel loop
5447# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5448#elif defined(MFC_OpenMP)
5449# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5450
5451# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5452!$omp end target teams loop
5453# 961 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5454#endif
5455# 962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5456 end if
5457# 964 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5458
5459 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
5460
5461 end subroutine s_hypo_hlld_riemann_solver
5462
5463 !> Copy the hypo interface velocities of a fused-solve pass from Riemann-space buffers to physical-space output arrays, called
5464 !! after the Riemann solver for each sweep direction. The plain routine handles the hat_L-anchored values (nc_iface_vel_rsx;
5465 !! used when hypo_nc_mode_interface is active, and as the hat_L pass of the dual-pass HLLD solve); the _hatR routine handles the
5466 !! hat_R-anchored values (nc_iface_vel_hatR_rsx) of the dual-pass solve. Both routines are emitted from one template so the two
5467 !! passes cannot drift apart.
5468 !! @param nc_iface_vel_vf Output: physical velocity components at interfaces
5469 !! @param norm_dir Sweep direction (1=x, 2=y, 3=z)
5470# 977 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5471 subroutine s_finalize_nc_iface_vel (nc_iface_vel_vf, norm_dir)
5472# 978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5473
5474 type(scalar_field), dimension(:), intent(inout) :: nc_iface_vel_vf
5475 integer, intent(in) :: norm_dir
5476 integer :: i, j, k, l
5477
5478 if (norm_dir == 2) then
5479
5480# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5481
5482# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5483#if defined(MFC_OpenACC)
5484# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5485!$acc parallel loop collapse(4) gang vector default(present)
5486# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5487#elif defined(MFC_OpenMP)
5488# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5489
5490# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5491
5492# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5493
5494# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5495!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5496# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5497#endif
5498# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5499 do i = 1, num_dims
5500 do l = is3%beg, is3%end
5501 do j = is1%beg, is1%end
5502 do k = is2%beg, is2%end
5503 nc_iface_vel_vf(i)%sf(k, j, l) = nc_iface_vel_rsx_vf(k, j, l, i)
5504# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5505 end do
5506 end do
5507 end do
5508 end do
5509
5510# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5511#if defined(MFC_OpenACC)
5512# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5513!$acc end parallel loop
5514# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5515#elif defined(MFC_OpenMP)
5516# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5517
5518# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5519!$omp end target teams loop
5520# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5521#endif
5522# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5523 else if (norm_dir == 1) then
5524
5525# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5526
5527# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5528#if defined(MFC_OpenACC)
5529# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5530!$acc parallel loop collapse(4) gang vector default(present)
5531# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5532#elif defined(MFC_OpenMP)
5533# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5534
5535# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5536
5537# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5538
5539# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5540!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5541# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5542#endif
5543# 997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5544 do i = 1, num_dims
5545 do l = is3%beg, is3%end
5546 do k = is2%beg, is2%end
5547 do j = is1%beg, is1%end
5548 nc_iface_vel_vf(i)%sf(j, k, l) = nc_iface_vel_rsx_vf(j, k, l, i)
5549# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5550 end do
5551 end do
5552 end do
5553 end do
5554
5555# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5556#if defined(MFC_OpenACC)
5557# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5558!$acc end parallel loop
5559# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5560#elif defined(MFC_OpenMP)
5561# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5562
5563# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5564!$omp end target teams loop
5565# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5566#endif
5567# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5568 else if (norm_dir == 3) then
5569
5570# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5571
5572# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5573#if defined(MFC_OpenACC)
5574# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5575!$acc parallel loop collapse(4) gang vector default(present)
5576# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5577#elif defined(MFC_OpenMP)
5578# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5579
5580# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5581
5582# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5583
5584# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5585!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5586# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5587#endif
5588# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5589 do i = 1, num_dims
5590 do l = is3%beg, is3%end
5591 do k = is2%beg, is2%end
5592 do j = is1%beg, is1%end
5593 nc_iface_vel_vf(i)%sf(l, k, j) = nc_iface_vel_rsx_vf(l, k, j, i)
5594# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5595 end do
5596 end do
5597 end do
5598 end do
5599
5600# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5601#if defined(MFC_OpenACC)
5602# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5603!$acc end parallel loop
5604# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5605#elif defined(MFC_OpenMP)
5606# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5607
5608# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5609!$omp end target teams loop
5610# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5611#endif
5612# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5613 end if
5614
5615 end subroutine s_finalize_nc_iface_vel
5616# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5617# 977 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5618 subroutine s_finalize_nc_iface_vel_hatr (nc_iface_vel_vf, norm_dir)
5619# 978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5620
5621 type(scalar_field), dimension(:), intent(inout) :: nc_iface_vel_vf
5622 integer, intent(in) :: norm_dir
5623 integer :: i, j, k, l
5624
5625 if (norm_dir == 2) then
5626
5627# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5628
5629# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5630#if defined(MFC_OpenACC)
5631# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5632!$acc parallel loop collapse(4) gang vector default(present)
5633# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5634#elif defined(MFC_OpenMP)
5635# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5636
5637# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5638
5639# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5640
5641# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5642!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5643# 984 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5644#endif
5645# 985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5646 do i = 1, num_dims
5647 do l = is3%beg, is3%end
5648 do j = is1%beg, is1%end
5649 do k = is2%beg, is2%end
5650 nc_iface_vel_vf(i)%sf(k, j, l) = nc_iface_vel_hatr_rsx_vf(k, j, l, i)
5651# 990 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5652 end do
5653 end do
5654 end do
5655 end do
5656
5657# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5658#if defined(MFC_OpenACC)
5659# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5660!$acc end parallel loop
5661# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5662#elif defined(MFC_OpenMP)
5663# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5664
5665# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5666!$omp end target teams loop
5667# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5668#endif
5669# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5670 else if (norm_dir == 1) then
5671
5672# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5673
5674# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5675#if defined(MFC_OpenACC)
5676# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5677!$acc parallel loop collapse(4) gang vector default(present)
5678# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5679#elif defined(MFC_OpenMP)
5680# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5681
5682# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5683
5684# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5685
5686# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5687!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5688# 996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5689#endif
5690# 997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5691 do i = 1, num_dims
5692 do l = is3%beg, is3%end
5693 do k = is2%beg, is2%end
5694 do j = is1%beg, is1%end
5695 nc_iface_vel_vf(i)%sf(j, k, l) = nc_iface_vel_hatr_rsx_vf(j, k, l, i)
5696# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5697 end do
5698 end do
5699 end do
5700 end do
5701
5702# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5703#if defined(MFC_OpenACC)
5704# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5705!$acc end parallel loop
5706# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5707#elif defined(MFC_OpenMP)
5708# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5709
5710# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5711!$omp end target teams loop
5712# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5713#endif
5714# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5715 else if (norm_dir == 3) then
5716
5717# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5718
5719# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5720#if defined(MFC_OpenACC)
5721# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5722!$acc parallel loop collapse(4) gang vector default(present)
5723# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5724#elif defined(MFC_OpenMP)
5725# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5726
5727# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5728
5729# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5730
5731# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5732!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5733# 1008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5734#endif
5735# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5736 do i = 1, num_dims
5737 do l = is3%beg, is3%end
5738 do k = is2%beg, is2%end
5739 do j = is1%beg, is1%end
5740 nc_iface_vel_vf(i)%sf(l, k, j) = nc_iface_vel_hatr_rsx_vf(l, k, j, i)
5741# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5742 end do
5743 end do
5744 end do
5745 end do
5746
5747# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5748#if defined(MFC_OpenACC)
5749# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5750!$acc end parallel loop
5751# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5752#elif defined(MFC_OpenMP)
5753# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5754
5755# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5756!$omp end target teams loop
5757# 1018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5758#endif
5759# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5760 end if
5761
5762 end subroutine s_finalize_nc_iface_vel_hatr
5763# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5764# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solver_hypo_hlld.fpp"
5765end module m_riemann_solver_hypo_hlld
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:402
m_eos::s_phase_bulk_modulus
subroutine, public s_phase_bulk_modulus(pres, alpha, alpha_rho, i, blkmod)
Bulk modulus rho c^2 of phase i at pressure pres: f_bulk_modulus for a constant-coefficient fluid,...
Definition m_eos.fpp.f90:1784
m_eos::s_compute_mixture_coefficients
subroutine, public s_compute_mixture_coefficients(alpha_rho_k, alpha_k, rho_k, gamma_k, pi_inf_k, qv_k)
Mixture coefficients of one state. Under bubbles_euler with num_fluids == 1 the sole advection slot a...
Definition m_eos.fpp.f90:1980
m_eos::s_compute_speed_of_sound
subroutine, public s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c, alpha_rho)
Speed of sound of a thermodynamic state. Enthalpy is not an argument: for a real state H,...
Definition m_eos.fpp.f90:2153
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:410
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:834
m_global_parameters::stress_perm
integer, dimension(6) stress_perm
Full tensor permutation: local basis -> physical storage index.
Definition m_global_parameters.fpp.f90:837
m_riemann_solver_hypo_hlld
Dual-pass HLLD approximate Riemann solver for hypoelastic flows, with non-conservative interface-velo...
Definition m_riemann_solver_hypo_hlld.fpp.f90:367
m_riemann_solver_hypo_hlld::s_finalize_nc_iface_vel_hatr
subroutine s_finalize_nc_iface_vel_hatr(nc_iface_vel_vf, norm_dir)
Definition m_riemann_solver_hypo_hlld.fpp.f90:5619
m_riemann_solver_hypo_hlld::f_hll_flux
real(wp) function f_hll_flux(s_l, s_r, f_l_i, f_r_i, u_l_i, u_r_i)
Per-component HLL flux on the compact (U_L, U_R, F_L, F_R) basis. Shared by the degenerate-fan fallba...
Definition m_riemann_solver_hypo_hlld.fpp.f90:446
m_riemann_solver_hypo_hlld::s_finalize_nc_iface_vel
subroutine s_finalize_nc_iface_vel(nc_iface_vel_vf, norm_dir)
Copy the hypo interface velocities of a fused-solve pass from Riemann-space buffers to physical-space...
Definition m_riemann_solver_hypo_hlld.fpp.f90:5472
m_riemann_solver_hypo_hlld::f_hlld_wave_zone
integer function f_hlld_wave_zone(s_l, s_lstar, s_m, s_rstar, s_r)
Classify the position of the interface (xi = 0) in the five-wave HLLD fan: 0 left of S_L,...
Definition m_riemann_solver_hypo_hlld.fpp.f90:388
m_riemann_solver_hypo_hlld::g_eff_roundoff_factor
real(wp), parameter g_eff_roundoff_factor
Four-epsilon roundoff band for G_eff: two mixture products, their sum, and the final signed sum....
Definition m_riemann_solver_hypo_hlld.fpp.f90:379
m_riemann_solver_hypo_hlld::s_hypo_hlld_riemann_solver
subroutine s_hypo_hlld_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)
HLLD Riemann solver resolves all 5 waves for the hypoelastic equations: 1 entropy wave,...
Definition m_riemann_solver_hypo_hlld.fpp.f90:495
m_riemann_state
Shared Riemann-solver module state and the per-sweep setup, state-buffer population,...
Definition m_riemann_state.fpp.f90:368
m_riemann_state::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_state.fpp.f90:381
m_riemann_state::is3
type(int_bounds_info) is3
Definition m_riemann_state.fpp.f90:519
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:381
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:2178
m_riemann_state::nc_iface_vel_rsx_vf
real(wp), dimension(:,:,:,:), allocatable nc_iface_vel_rsx_vf
Definition m_riemann_state.fpp.f90:413
m_riemann_state::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_state.fpp.f90:536
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:1045
m_riemann_state::is2
type(int_bounds_info) is2
Definition m_riemann_state.fpp.f90:519
m_riemann_state::s_finalize_riemann_solver
subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
Reshape and copy the Riemann-solver flux buffers back to the physical-space output arrays for the sel...
Definition m_riemann_state.fpp.f90:3432
m_riemann_state::flux_hatr_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_hatr_rsx_vf
Dual-pass HLLD second flux set: the hat_R-anchored fluxes (and, for axisymmetric runs,...
Definition m_riemann_state.fpp.f90:430
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:399
m_riemann_state::nc_iface_vel_hatr_rsx_vf
real(wp), dimension(:,:,:,:), allocatable nc_iface_vel_hatr_rsx_vf
Definition m_riemann_state.fpp.f90:444
m_riemann_state::flux_gsrc_hatr_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_gsrc_hatr_rsx_vf
Definition m_riemann_state.fpp.f90:458
m_riemann_state::is1
type(int_bounds_info) is1
Definition m_riemann_state.fpp.f90:519
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:367
m_variables_conversion::f_elastic_energy
real(wp) function, public f_elastic_energy(tau, g, is_shear)
Elastic strain energy of one stress component, doubled for a shear component: the tensor stores it on...
Definition m_variables_conversion.fpp.f90:2482
m_variables_conversion::s_compute_energy
subroutine, public s_compute_energy(pres, alpha_rho_k, alpha_k, vel_sum, e)
Total energy per unit volume, thermodynamic terms only. Callers add magnetic and elastic energy,...
Definition m_variables_conversion.fpp.f90:2424
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:450
m_derived_types::riemann_states_vec3
Left and right Riemann states for 3-component vectors.
Definition m_derived_types.fpp.f90:438
m_derived_types::riemann_states
Left and right Riemann states.
Definition m_derived_types.fpp.f90:432
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:370