MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_weno.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2!>
3!! @file
4!! @brief Contains module m_weno
5# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
6! This file exists so that Fypp can be run without generating case.fpp files for
7! each target. This is useful when generating documentation, for example. This
8! should also let MFC be built with CMake directly, without invoking mfc.sh.
9
10! For pre-process.
11# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
12
13! For moving immersed boundaries in simulation
14# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
15# 5 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
16# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
17# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
19# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44! New line at end of file is required for FYPP
45# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
46# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
47# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
48# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73! New line at end of file is required for FYPP
74# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
75
76# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152! New line at end of file is required for FYPP
153# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
154# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
155# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
156# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181! New line at end of file is required for FYPP
182# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
183
184# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239! New line at end of file is required for FYPP
240# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
241
242! GPU parallel region (scalar reductions, maxval/minval)
243# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245! GPU parallel loop over threads (most common GPU macro)
246# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248! Required closing for GPU_PARALLEL_LOOP
249# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251! Mark routine for device compilation
252# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254! Declare device-resident data
255# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! Inner loop within a GPU parallel region
258# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Scoped GPU data region
261# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Host code with device pointers (for MPI with GPU buffers)
264# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Allocate device memory (unscoped)
267# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! Free device memory
270# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! Atomic operation on device
273# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! End atomic capture block
276# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Copy data between host and device
279# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Synchronization barrier
282# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Import GPU library module (openacc or omp_lib)
285# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! Emit code only for AMD compiler
288# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Emit code for non-Cray compilers
291# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293! Emit code only for Cray compiler
294# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295
296! Emit code for non-NVIDIA compilers
297# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298
299# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301! New line at end of file is required for FYPP
302# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
303
304# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
305
306! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
307! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
308! example see misc/nvidia_uvm/bind.sh.
309# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Allocate and create GPU device memory
312# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Free GPU device memory and deallocate
315# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for vector fields
318# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320! Cray-specific GPU pointer setup for scalar fields
321# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323! Cray-specific GPU pointer setup for acoustic source spatials
324# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325
326# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329! New line at end of file is required for FYPP
330# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
331
332!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
333module m_weno
334
335 use m_derived_types
336 use m_global_parameters
337 use m_variables_conversion
338 use m_mpi_proxy
339 use m_thinc, only: s_thinc_compression
340 use m_nvtx
341
342 private; public :: s_initialize_weno_module, s_finalize_weno_module, s_weno, s_pack_weno_input_arr
343
344 !> @name The cell-average variables that will be WENO-reconstructed unpacked into an array for performance
345 !> @{
346 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_weno
347 !> @}
348
349# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
350#if defined(MFC_OpenACC)
351# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
352!$acc declare create(v_rs_weno)
353# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
354#elif defined(MFC_OpenMP)
355# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
356!$omp declare target (v_rs_weno)
357# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
358#endif
359
360 ! WENO Coefficients
361
362 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at the left and right quadrature points (QP), in
363 !! the x-, y- and z-directions. Note that the first dimension of the array identifies the polynomial, the second dimension
364 !! identifies the position of its coefficients and the last dimension denotes the cell-location in the relevant coordinate
365 !! direction.
366 !> @{
367 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_x
368 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_y
369 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_z
370 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_x
371 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_y
372 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_z
373 !> @}
374
375# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
376#if defined(MFC_OpenACC)
377# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
378!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
379# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
380#elif defined(MFC_OpenMP)
381# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
382!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
383# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
384#endif
385
386# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
387#if defined(MFC_OpenACC)
388# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
389!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
390# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
391#elif defined(MFC_OpenMP)
392# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
393!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
394# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
395#endif
396
397 !> @name The ideal weights at the left and the right cell-boundaries and at the left and the right quadrature points, in x-, y-
398 !! and z-directions. Note that the first dimension of the array identifies the weight, while the last denotes the cell-location
399 !! in the relevant coordinate direction.
400 !> @{
401 real(wp), target, allocatable, dimension(:,:) :: d_cbl_x
402 real(wp), target, allocatable, dimension(:,:) :: d_cbl_y
403 real(wp), target, allocatable, dimension(:,:) :: d_cbl_z
404 real(wp), target, allocatable, dimension(:,:) :: d_cbr_x
405 real(wp), target, allocatable, dimension(:,:) :: d_cbr_y
406 real(wp), target, allocatable, dimension(:,:) :: d_cbr_z
407 !> @}
408
409# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
410#if defined(MFC_OpenACC)
411# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
412!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
413# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
414#elif defined(MFC_OpenMP)
415# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
416!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
417# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
418#endif
419
420 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note that the first array dimension identifies the
421 !! smoothness indicator, the second identifies the position of its coefficients and the last denotes the cell-location in the
422 !! relevant coordinate direction.
423 !> @{
424 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_x
425 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_y
426 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_z
427 !> @}
428
429# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
430#if defined(MFC_OpenACC)
431# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
432!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
433# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
434#elif defined(MFC_OpenMP)
435# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
436!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
437# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
438#endif
439
440 ! END: WENO Coefficients
441
442 integer :: v_size !< Number of WENO-reconstructed cell-average variables
443
444# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
445#if defined(MFC_OpenACC)
446# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447!$acc declare create(v_size)
448# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449#elif defined(MFC_OpenMP)
450# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
451!$omp declare target (v_size)
452# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
453#endif
454
455 logical :: uniform_grid(3) !< True if grid spacing is uniform in each direction
456
457# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
458#if defined(MFC_OpenACC)
459# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
460!$acc declare create(uniform_grid)
461# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
462#elif defined(MFC_OpenMP)
463# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
464!$omp declare target (uniform_grid)
465# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
466#endif
467
468 !> @name Indical bounds in the s1-, s2- and s3-directions
469 !> @{
470 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
471#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
472
473# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
474#if defined(MFC_OpenACC)
475# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
476!$acc declare create(is1_weno, is2_weno, is3_weno)
477# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
478#elif defined(MFC_OpenMP)
479# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
480!$omp declare target (is1_weno, is2_weno, is3_weno)
481# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
482#endif
483#endif
484 !
485 !> @}
486
487contains
488
489 !> Initialize the WENO module
490 impure subroutine s_initialize_weno_module
491
492 if (weno_order == 1) return
493
494 ! Allocating/Computing WENO Coefficients in x-direction
495 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
496 if (n == 0) then
497 is2_weno%beg = 0
498 else
499 is2_weno%beg = -buff_size
500 end if
501
502 is2_weno%end = n - is2_weno%beg
503
504 if (p == 0) then
505 is3_weno%beg = 0
506 else
507 is3_weno%beg = -buff_size
508 end if
509
510 is3_weno%end = p - is3_weno%beg
511
512#ifdef MFC_DEBUG
513# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
514 block
515# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
516 use iso_fortran_env, only: output_unit
517# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
518
519# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
520 print *, 'm_weno.fpp:107: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
521# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
522
523# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
524 call flush (output_unit)
525# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
526 end block
527# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
528#endif
529# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
530 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
531# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
532
533# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
534
535# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
536#if defined(MFC_OpenACC)
537# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
538!$acc enter data create(poly_coef_cbL_x)
539# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
540#elif defined(MFC_OpenMP)
541# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
542!$omp target enter data map(always,alloc:poly_coef_cbL_x)
543# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
544#endif
545#ifdef MFC_DEBUG
546# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
547 block
548# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
549 use iso_fortran_env, only: output_unit
550# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
551
552# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
553 print *, 'm_weno.fpp:108: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
554# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
555
556# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
557 call flush (output_unit)
558# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
559 end block
560# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
561#endif
562# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
563 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
564# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
565
566# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
567
568# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
569#if defined(MFC_OpenACC)
570# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
571!$acc enter data create(poly_coef_cbR_x)
572# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
573#elif defined(MFC_OpenMP)
574# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
575!$omp target enter data map(always,alloc:poly_coef_cbR_x)
576# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
577#endif
578
579#ifdef MFC_DEBUG
580# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
581 block
582# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
583 use iso_fortran_env, only: output_unit
584# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
585
586# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
587 print *, 'm_weno.fpp:110: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
588# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
589
590# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
591 call flush (output_unit)
592# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593 end block
594# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595#endif
596# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
598# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599
600# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601
602# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603#if defined(MFC_OpenACC)
604# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605!$acc enter data create(d_cbL_x)
606# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607#elif defined(MFC_OpenMP)
608# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
609!$omp target enter data map(always,alloc:d_cbL_x)
610# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
611#endif
612#ifdef MFC_DEBUG
613# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
614 block
615# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
616 use iso_fortran_env, only: output_unit
617# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
618
619# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
620 print *, 'm_weno.fpp:111: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
621# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
622
623# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
624 call flush (output_unit)
625# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
626 end block
627# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
628#endif
629# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
630 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
631# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
632
633# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
634
635# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
636#if defined(MFC_OpenACC)
637# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
638!$acc enter data create(d_cbR_x)
639# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
640#elif defined(MFC_OpenMP)
641# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
642!$omp target enter data map(always,alloc:d_cbR_x)
643# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
644#endif
645
646#ifdef MFC_DEBUG
647# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
648 block
649# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
650 use iso_fortran_env, only: output_unit
651# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
652
653# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
654 print *, 'm_weno.fpp:113: ', '@:ALLOCATE(beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
655# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
656
657# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
658 call flush (output_unit)
659# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
660 end block
661# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
662#endif
663# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664 allocate (beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
665# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666
667# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668
669# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670#if defined(MFC_OpenACC)
671# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672!$acc enter data create(beta_coef_x)
673# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674#elif defined(MFC_OpenMP)
675# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676!$omp target enter data map(always,alloc:beta_coef_x)
677# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678#endif
679# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680 ! Number of cross terms for dvd = (k-1)(k-1+1)/2, where weno_polyn = k-1 Note: k-1 not k because we are using value
681 ! differences (dvd) not the values themselves
682
683 call s_compute_weno_coefficients(1, is1_weno)
684
685#ifdef MFC_DEBUG
686# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
687 block
688# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
689 use iso_fortran_env, only: output_unit
690# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
691
692# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
693 print *, 'm_weno.fpp:120: ', '@:ALLOCATE(v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
694# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
695
696# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
697 call flush (output_unit)
698# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
699 end block
700# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
701#endif
702# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
703 allocate (v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
704# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
705
706# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
707
708# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
709#if defined(MFC_OpenACC)
710# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
711!$acc enter data create(v_rs_weno)
712# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713#elif defined(MFC_OpenMP)
714# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
715!$omp target enter data map(always,alloc:v_rs_weno)
716# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
717#endif
718
719 ! Allocating/Computing WENO Coefficients in y-direction
720 if (n == 0) return
721
722 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
723 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
724
725 if (p == 0) then
726 is3_weno%beg = 0
727 else
728 is3_weno%beg = -buff_size
729 end if
730
731 is3_weno%end = p - is3_weno%beg
732
733#ifdef MFC_DEBUG
734# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
735 block
736# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
737 use iso_fortran_env, only: output_unit
738# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
739
740# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
741 print *, 'm_weno.fpp:136: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
742# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
743
744# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
745 call flush (output_unit)
746# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 end block
748# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749#endif
750# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
752# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753
754# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755
756# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757#if defined(MFC_OpenACC)
758# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759!$acc enter data create(poly_coef_cbL_y)
760# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761#elif defined(MFC_OpenMP)
762# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763!$omp target enter data map(always,alloc:poly_coef_cbL_y)
764# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
765#endif
766#ifdef MFC_DEBUG
767# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
768 block
769# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
770 use iso_fortran_env, only: output_unit
771# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
772
773# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
774 print *, 'm_weno.fpp:137: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
775# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
776
777# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
778 call flush (output_unit)
779# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
780 end block
781# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782#endif
783# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
785# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786
787# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788
789# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790#if defined(MFC_OpenACC)
791# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792!$acc enter data create(poly_coef_cbR_y)
793# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794#elif defined(MFC_OpenMP)
795# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
796!$omp target enter data map(always,alloc:poly_coef_cbR_y)
797# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798#endif
799
800#ifdef MFC_DEBUG
801# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
802 block
803# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804 use iso_fortran_env, only: output_unit
805# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806
807# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808 print *, 'm_weno.fpp:139: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
809# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810
811# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
812 call flush (output_unit)
813# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
814 end block
815# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
816#endif
817# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
818 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
819# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
820
821# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
822
823# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
824#if defined(MFC_OpenACC)
825# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
826!$acc enter data create(d_cbL_y)
827# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
828#elif defined(MFC_OpenMP)
829# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
830!$omp target enter data map(always,alloc:d_cbL_y)
831# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
832#endif
833#ifdef MFC_DEBUG
834# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
835 block
836# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
837 use iso_fortran_env, only: output_unit
838# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
839
840# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
841 print *, 'm_weno.fpp:140: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
842# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
843
844# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
845 call flush (output_unit)
846# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
847 end block
848# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849#endif
850# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
852# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853
854# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855
856# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857#if defined(MFC_OpenACC)
858# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859!$acc enter data create(d_cbR_y)
860# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861#elif defined(MFC_OpenMP)
862# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
863!$omp target enter data map(always,alloc:d_cbR_y)
864# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865#endif
866
867#ifdef MFC_DEBUG
868# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
869 block
870# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871 use iso_fortran_env, only: output_unit
872# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873
874# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875 print *, 'm_weno.fpp:142: ', '@:ALLOCATE(beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
876# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877
878# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
879 call flush (output_unit)
880# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
881 end block
882# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
883#endif
884# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
885 allocate (beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
886# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
887
888# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
889
890# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
891#if defined(MFC_OpenACC)
892# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
893!$acc enter data create(beta_coef_y)
894# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
895#elif defined(MFC_OpenMP)
896# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
897!$omp target enter data map(always,alloc:beta_coef_y)
898# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
899#endif
900# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
901
902 call s_compute_weno_coefficients(2, is2_weno)
903
904 ! Allocating/Computing WENO Coefficients in z-direction
905 if (p == 0) return
906
907 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
908 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
909 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
910
911#ifdef MFC_DEBUG
912# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
913 block
914# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
915 use iso_fortran_env, only: output_unit
916# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
917
918# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
919 print *, 'm_weno.fpp:154: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
920# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
921
922# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
923 call flush (output_unit)
924# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
925 end block
926# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
927#endif
928# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
929 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
930# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
931
932# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
933
934# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
935#if defined(MFC_OpenACC)
936# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
937!$acc enter data create(poly_coef_cbL_z)
938# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
939#elif defined(MFC_OpenMP)
940# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
941!$omp target enter data map(always,alloc:poly_coef_cbL_z)
942# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
943#endif
944#ifdef MFC_DEBUG
945# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
946 block
947# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
948 use iso_fortran_env, only: output_unit
949# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950
951# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
952 print *, 'm_weno.fpp:155: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
953# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
954
955# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956 call flush (output_unit)
957# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958 end block
959# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960#endif
961# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
963# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964
965# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966
967# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968#if defined(MFC_OpenACC)
969# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970!$acc enter data create(poly_coef_cbR_z)
971# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972#elif defined(MFC_OpenMP)
973# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
974!$omp target enter data map(always,alloc:poly_coef_cbR_z)
975# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976#endif
977
978#ifdef MFC_DEBUG
979# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
980 block
981# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
982 use iso_fortran_env, only: output_unit
983# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984
985# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986 print *, 'm_weno.fpp:157: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
987# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988
989# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
990 call flush (output_unit)
991# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992 end block
993# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
994#endif
995# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
996 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
997# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
998
999# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1000
1001# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1002#if defined(MFC_OpenACC)
1003# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1004!$acc enter data create(d_cbL_z)
1005# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1006#elif defined(MFC_OpenMP)
1007# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1008!$omp target enter data map(always,alloc:d_cbL_z)
1009# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1010#endif
1011#ifdef MFC_DEBUG
1012# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1013 block
1014# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1015 use iso_fortran_env, only: output_unit
1016# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1017
1018# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1019 print *, 'm_weno.fpp:158: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1020# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1021
1022# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023 call flush (output_unit)
1024# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025 end block
1026# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027#endif
1028# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1029 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1030# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1031
1032# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1033
1034# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1035#if defined(MFC_OpenACC)
1036# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1037!$acc enter data create(d_cbR_z)
1038# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1039#elif defined(MFC_OpenMP)
1040# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1041!$omp target enter data map(always,alloc:d_cbR_z)
1042# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1043#endif
1044
1045#ifdef MFC_DEBUG
1046# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1047 block
1048# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1049 use iso_fortran_env, only: output_unit
1050# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1051
1052# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1053 print *, 'm_weno.fpp:160: ', '@:ALLOCATE(beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
1054# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1055
1056# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1057 call flush (output_unit)
1058# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1059 end block
1060# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1061#endif
1062# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1063 allocate (beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
1064# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1065
1066# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1067
1068# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1069#if defined(MFC_OpenACC)
1070# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1071!$acc enter data create(beta_coef_z)
1072# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1073#elif defined(MFC_OpenMP)
1074# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1075!$omp target enter data map(always,alloc:beta_coef_z)
1076# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1077#endif
1078# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1079
1080 call s_compute_weno_coefficients(3, is3_weno)
1081
1082 end subroutine s_initialize_weno_module
1083
1084 !> Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction
1085 subroutine s_compute_weno_coefficients(weno_dir, is)
1086
1087 ! Compute WENO coefficients for a given coordinate direction. Shu (1997)
1088 integer, intent(in) :: weno_dir
1089 type(int_bounds_info), intent(in) :: is
1090 integer :: s
1091 real(wp), pointer, dimension(:) :: s_cb => null() !< Cell-boundary locations in the s-direction
1092 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1093 integer :: i !< Generic loop iterator
1094 real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil
1095 real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1096 real(wp) :: h0 !< Reference spacing for uniform-grid detection
1097
1098 ! Determine cell count, boundary locations, and BCs for selected WENO direction
1099
1100 if (weno_dir == 1) then
1101 s = m; s_cb => x_cb; bc_s = bc_x
1102 else if (weno_dir == 2) then
1103 s = n; s_cb => y_cb; bc_s = bc_y
1104 else
1105 s = p; s_cb => z_cb; bc_s = bc_z
1106 end if
1107
1108# 192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1109 ! Computing WENO3 Coefficients
1110 if (weno_dir == 1) then
1111 if (weno_order == 3) then
1112 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1113 ! Polynomial reconstruction coefficients
1114 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1115 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1116
1117 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1118 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1119
1120 ! Ideal (linear) weights
1121 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1122 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1123
1124 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1125 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1126
1127 ! Smoothness indicator coefficients
1128 beta_coef_x(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
1129 beta_coef_x(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
1130 end do
1131
1132 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1133 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1134 if (null_weights) then
1135 if (bc_s%beg == bc_riemann_extrap) then
1136 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1137 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1138 end if
1139
1140 if (bc_s%end == bc_riemann_extrap) then
1141 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1142 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1143 end if
1144 end if
1145 ! END: Computing WENO3 Coefficients
1146
1147 ! Computing WENO5 Coefficients
1148 else if (weno_order == 5) then
1149 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1150 ! Polynomial reconstruction coefficients
1151 poly_coef_cbr_x(i + 1, 0, &
1152 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1153 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1154 poly_coef_cbr_x(i + 1, 1, &
1155 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1156 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1157 poly_coef_cbr_x(i + 1, 1, &
1158 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1159 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1160 poly_coef_cbr_x(i + 1, 2, &
1161 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1162 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1163 poly_coef_cbl_x(i + 1, 0, &
1164 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1165 & *(s_cb(i + 3) - s_cb(i + 1)))
1166 poly_coef_cbl_x(i + 1, 1, &
1167 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1168 & + 2))*(s_cb(i) - s_cb(i + 2)))
1169 poly_coef_cbl_x(i + 1, 1, &
1170 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1171 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1172 poly_coef_cbl_x(i + 1, 2, &
1173 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1174 & *(s_cb(i - 2) - s_cb(i + 1)))
1175
1176 poly_coef_cbr_x(i + 1, 0, &
1177 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1178 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1179 poly_coef_cbr_x(i + 1, 2, &
1180 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1181 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1182 poly_coef_cbl_x(i + 1, 0, &
1183 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1184 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1185 poly_coef_cbl_x(i + 1, 2, &
1186 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1187 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1188
1189 ! Ideal (linear) weights
1190 d_cbr_x(0, &
1191 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1192 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1193 d_cbr_x(2, &
1194 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1195 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1196 d_cbl_x(0, &
1197 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1198 & *(s_cb(i + 3) - s_cb(i - 1)))
1199 d_cbl_x(2, &
1200 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1201 & *(s_cb(i - 2) - s_cb(i + 3)))
1202
1203 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1204 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1205
1206 ! Smoothness indicator coefficients
1207 beta_coef_x(i + 1, 0, &
1208 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1209 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1210 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1211
1212 beta_coef_x(i + 1, 0, &
1213 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1214 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1215 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1216 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1217
1218 beta_coef_x(i + 1, 0, &
1219 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1220 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1221 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1222 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1223
1224 beta_coef_x(i + 1, 1, &
1225 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1226 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1227 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1228
1229 beta_coef_x(i + 1, 1, &
1230 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1231 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1232 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1233 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1234
1235 beta_coef_x(i + 1, 1, &
1236 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1237 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1238 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1239
1240 beta_coef_x(i + 1, 2, &
1241 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1242 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1243 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1244 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1245
1246 beta_coef_x(i + 1, 2, &
1247 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1248 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1249 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1250 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1251
1252 beta_coef_x(i + 1, 2, &
1253 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1254 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1255 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1256 end do
1257
1258 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1259 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1260 if (null_weights) then
1261 if (bc_s%beg == bc_riemann_extrap) then
1262 d_cbr_x(1:2,0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1263 d_cbl_x(1:2,0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1264 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:,1) = d_cbr_x(:,1)/sum(d_cbr_x(:,1))
1265 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:,1) = d_cbl_x(:,1)/sum(d_cbl_x(:,1))
1266 end if
1267
1268 if (bc_s%end == bc_riemann_extrap) then
1269 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:,s - 1) = d_cbr_x(:, &
1270 & s - 1)/sum(d_cbr_x(:,s - 1))
1271 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:,s - 1) = d_cbl_x(:, &
1272 & s - 1)/sum(d_cbl_x(:,s - 1))
1273 d_cbr_x(0:1,s) = 0._wp; d_cbr_x(2, s) = 1._wp
1274 d_cbl_x(0:1,s) = 0._wp; d_cbl_x(2, s) = 1._wp
1275 end if
1276 end if
1277 else
1278 if (.not. teno) then
1279 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1280 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1281 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1282 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1283 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1284 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1285 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1286 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1287 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1288 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1289 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1290 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1291
1292 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1293 d_cbr_x(0, &
1294 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1295 & *(w(1) - w(8)))
1296 d_cbr_x(1, &
1297 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1298 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
1299 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1300 & *(w(2) - w(8)))
1301 d_cbr_x(2, &
1302 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1303 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
1304 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1305 & *(w(3) - w(8)))
1306 d_cbr_x(3, &
1307 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1308 & *(w(3) - w(8)))
1309
1310 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
1311 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
1312 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
1313 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
1314 w(1) = s_cb(i + 4) - s_cb(i)
1315 w(2) = s_cb(i + 3) - s_cb(i)
1316 w(3) = s_cb(i + 2) - s_cb(i)
1317 w(4) = s_cb(i + 1) - s_cb(i)
1318 w(5) = s_cb(i) - s_cb(i)
1319 w(6) = s_cb(i - 1) - s_cb(i)
1320 w(7) = s_cb(i - 2) - s_cb(i)
1321 w(8) = s_cb(i - 3) - s_cb(i)
1322 d_cbl_x(0, &
1323 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1324 & *(w(3) - w(8)))
1325 d_cbl_x(1, &
1326 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1327 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
1328 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1329 & *(w(3) - w(8)))
1330 d_cbl_x(2, &
1331 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1332 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
1333 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1334 & *(w(2) - w(8)))
1335 d_cbl_x(3, &
1336 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1337 & *(w(1) - w(8)))
1338 ! Note: Left has the reversed order of both points and coefficients compared to the right
1339
1340 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1341 poly_coef_cbr_x(i + 1, 0, &
1342 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1343 & + y(2) + y(3) + y(4)))
1344 poly_coef_cbr_x(i + 1, 0, &
1345 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1346 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
1347 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1348 poly_coef_cbr_x(i + 1, 0, &
1349 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1350 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1351 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1352
1353 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1354 poly_coef_cbr_x(i + 1, 1, &
1355 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1356 & + y(2) + y(3) + y(4)))
1357 poly_coef_cbr_x(i + 1, 1, &
1358 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1359 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
1360 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1361 poly_coef_cbr_x(i + 1, 1, &
1362 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1363 & + y(2) + y(3) + y(4)))
1364
1365 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1366 poly_coef_cbr_x(i + 1, 2, &
1367 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1368 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1369 poly_coef_cbr_x(i + 1, 2, &
1370 & 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1371 & + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) &
1372 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1373 poly_coef_cbr_x(i + 1, 2, &
1374 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1375 & + y(2) + y(3) + y(4)))
1376
1377 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1378 poly_coef_cbr_x(i + 1, 3, &
1379 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1380 & + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) &
1381 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1382 poly_coef_cbr_x(i + 1, 3, &
1383 & 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) &
1384 & + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2)) &
1385 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1386 & + y(4)))
1387 poly_coef_cbr_x(i + 1, 3, &
1388 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1389 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1390
1391 ! Element-wise: see the no-reversed-sections note above.
1392 y(1) = s_cb(i + 1) - s_cb(i)
1393 y(2) = s_cb(i) - s_cb(i - 1)
1394 y(3) = s_cb(i - 1) - s_cb(i - 2)
1395 y(4) = s_cb(i - 2) - s_cb(i - 3)
1396 poly_coef_cbl_x(i + 1, 3, &
1397 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1398 & + y(2) + y(3) + y(4)))
1399 poly_coef_cbl_x(i + 1, 3, &
1400 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1401 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
1402 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1403 poly_coef_cbl_x(i + 1, 3, &
1404 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1405 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1406 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1407
1408 ! Element-wise: see the no-reversed-sections note above.
1409 y(1) = s_cb(i + 2) - s_cb(i + 1)
1410 y(2) = s_cb(i + 1) - s_cb(i)
1411 y(3) = s_cb(i) - s_cb(i - 1)
1412 y(4) = s_cb(i - 1) - s_cb(i - 2)
1413 poly_coef_cbl_x(i + 1, 2, &
1414 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1415 & + y(2) + y(3) + y(4)))
1416 poly_coef_cbl_x(i + 1, 2, &
1417 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1418 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
1419 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1420 poly_coef_cbl_x(i + 1, 2, &
1421 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1422 & + y(2) + y(3) + y(4)))
1423
1424 ! Element-wise: see the no-reversed-sections note above.
1425 y(1) = s_cb(i + 3) - s_cb(i + 2)
1426 y(2) = s_cb(i + 2) - s_cb(i + 1)
1427 y(3) = s_cb(i + 1) - s_cb(i)
1428 y(4) = s_cb(i) - s_cb(i - 1)
1429 poly_coef_cbl_x(i + 1, 1, &
1430 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1431 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1432 poly_coef_cbl_x(i + 1, 1, &
1433 & 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1434 & + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) &
1435 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1436 poly_coef_cbl_x(i + 1, 1, &
1437 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1438 & + y(2) + y(3) + y(4)))
1439
1440 ! Element-wise: see the no-reversed-sections note above.
1441 y(1) = s_cb(i + 4) - s_cb(i + 3)
1442 y(2) = s_cb(i + 3) - s_cb(i + 2)
1443 y(3) = s_cb(i + 2) - s_cb(i + 1)
1444 y(4) = s_cb(i + 1) - s_cb(i)
1445 poly_coef_cbl_x(i + 1, 0, &
1446 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1447 & + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) &
1448 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1449 poly_coef_cbl_x(i + 1, 0, &
1450 & 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) &
1451 & + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2)) &
1452 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1453 & + y(4)))
1454 poly_coef_cbl_x(i + 1, 0, &
1455 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1456 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1457
1458 poly_coef_cbl_x(i + 1,:,:) = -poly_coef_cbl_x(i + 1,:,:)
1459 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1460
1461 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1462 beta_coef_x(i + 1, 3, &
1463 & 0) = (4*y(4)**2*(5*y(1)**2*y(2)**2 + 20*y(1)**2*y(2)*y(3) + 15*y(1)**2*y(2)*y(4) &
1464 & + 20*y(1)**2*y(3)**2 + 30*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 10*y(1)*y(2) &
1465 & **3 + 60*y(1)*y(2)**2*y(3) + 45*y(1)*y(2)**2*y(4) + 110*y(1)*y(2)*y(3)**2 &
1466 & + 165*y(1)*y(2)*y(3)*y(4) + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1) &
1467 & *y(3)**2*y(4) + 400*y(1)*y(3)*y(4)**2 + 225*y(1)*y(4)**3 + 5*y(2)**4 + 40*y(2) &
1468 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
1469 & + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3) &
1470 & *y(4)**2 + 450*y(2)*y(4)**3 + 45*y(3)**4 + 135*y(3)**3*y(4) + 600*y(3)**2*y(4) &
1471 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
1472 & **2*(y(1) + y(2) + y(3) + y(4))**2)
1473 beta_coef_x(i + 1, 3, &
1474 & 1) = -(4*y(4)**2*(10*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3) &
1475 & **2 + 25*y(1)**3*y(3)*y(4) + 105*y(1)**3*y(4)**2 + 40*y(1)**2*y(2)**2*y(3) &
1476 & + 20*y(1)**2*y(2)**2*y(4) + 130*y(1)**2*y(2)*y(3)**2 + 155*y(1)**2*y(2)*y(3)*y(4) &
1477 & + 535*y(1)**2*y(2)*y(4)**2 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) &
1478 & + 790*y(1)**2*y(3)*y(4)**2 + 415*y(1)**2*y(4)**3 + 60*y(1)*y(2)**3*y(3) + 30*y(1) &
1479 & *y(2)**3*y(4) + 270*y(1)*y(2)**2*y(3)**2 + 315*y(1)*y(2)**2*y(3)*y(4) + 975*y(1) &
1480 & *y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1) &
1481 & *y(2)*y(3)*y(4)**2 + 1460*y(1)*y(2)*y(4)**3 + 150*y(1)*y(3)**4 + 360*y(1)*y(3) &
1482 & **3*y(4) + 2000*y(1)*y(3)**2*y(4)**2 + 2005*y(1)*y(3)*y(4)**3 + 2077*y(1)*y(4) &
1483 & **4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 + 210*y(2)**3*y(3) &
1484 & *y(4) + 650*y(2)**3*y(4)**2 + 360*y(2)**2*y(3)**3 + 645*y(2)**2*y(3)**2*y(4) &
1485 & + 2850*y(2)**2*y(3)*y(4)**2 + 1460*y(2)**2*y(4)**3 + 300*y(2)*y(3)**4 + 720*y(2) &
1486 & *y(3)**3*y(4) + 4000*y(2)*y(3)**2*y(4)**2 + 4010*y(2)*y(3)*y(4)**3 + 4154*y(2) &
1487 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
1488 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
1489 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1490 beta_coef_x(i + 1, 3, &
1491 & 2) = (4*y(4)**2*(10*y(2)**3*y(3) + 5*y(2)**3*y(4) + 50*y(2)**2*y(3)**2 + 60*y(2) &
1492 & **2*y(3)*y(4) + 10*y(1)*y(2)**2*y(3) + 215*y(2)**2*y(4)**2 + 5*y(1)*y(2)**2*y(4) &
1493 & + 70*y(2)*y(3)**3 + 130*y(2)*y(3)**2*y(4) + 30*y(1)*y(2)*y(3)**2 + 775*y(2)*y(3) &
1494 & *y(4)**2 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 &
1495 & + 30*y(3)**4 + 75*y(3)**3*y(4) + 20*y(1)*y(3)**3 + 665*y(3)**2*y(4)**2 + 35*y(1) &
1496 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
1497 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1498 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1499 beta_coef_x(i + 1, 3, &
1500 & 3) = (4*y(4)**2*(5*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 50*y(1)**4*y(4)**2 &
1501 & + 30*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 300*y(1)**3*y(2)*y(4)**2 &
1502 & + 30*y(1)**3*y(3)**3 + 45*y(1)**3*y(3)**2*y(4) + 415*y(1)**3*y(3)*y(4)**2 &
1503 & + 200*y(1)**3*y(4)**3 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
1504 & + 750*y(1)**2*y(2)**2*y(4)**2 + 150*y(1)**2*y(2)*y(3)**3 + 225*y(1)**2*y(2)*y(3) &
1505 & **2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 1000*y(1)**2*y(2)*y(4)**3 + 75*y(1) &
1506 & **2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1) &
1507 & **2*y(3)*y(4)**3 + 1081*y(1)**2*y(4)**4 + 90*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2) &
1508 & **3*y(3)*y(4) + 900*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1) &
1509 & *y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 + 1800*y(1)*y(2)**2*y(4) &
1510 & **3 + 270*y(1)*y(2)*y(3)**4 + 540*y(1)*y(2)*y(3)**3*y(4) + 5025*y(1)*y(2)*y(3) &
1511 & **2*y(4)**2 + 4755*y(1)*y(2)*y(3)*y(4)**3 + 4224*y(1)*y(2)*y(4)**4 + 90*y(1)*y(3) &
1512 & **5 + 225*y(1)*y(3)**4*y(4) + 2190*y(1)*y(3)**3*y(4)**2 + 3060*y(1)*y(3)**2*y(4) &
1513 & **3 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2) &
1514 & **4*y(3)*y(4) + 450*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3) &
1515 & **2*y(4) + 2490*y(2)**3*y(3)*y(4)**2 + 1200*y(2)**3*y(4)**3 + 270*y(2)**2*y(3) &
1516 & **4 + 540*y(2)**2*y(3)**3*y(4) + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3) &
1517 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
1518 & + 4380*y(2)*y(3)**3*y(4)**2 + 6120*y(2)*y(3)**2*y(4)**3 + 9058*y(2)*y(3)*y(4)**4 &
1519 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
1520 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
1521 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1522 & + y(3) + y(4))**2)
1523 beta_coef_x(i + 1, 3, &
1524 & 4) = -(4*y(4)**2*(10*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 100*y(1) &
1525 & **2*y(2)*y(4)**2 + 10*y(1)**2*y(3)**3 + 15*y(1)**2*y(3)**2*y(4) + 205*y(1) &
1526 & **2*y(3)*y(4)**2 + 100*y(1)**2*y(4)**3 + 30*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2) &
1527 & **2*y(3)*y(4) + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2) &
1528 & *y(3)**2*y(4) + 1030*y(1)*y(2)*y(3)*y(4)**2 + 500*y(1)*y(2)*y(4)**3 + 30*y(1) &
1529 & *y(3)**4 + 60*y(1)*y(3)**3*y(4) + 835*y(1)*y(3)**2*y(4)**2 + 805*y(1)*y(3)*y(4) &
1530 & **3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 300*y(2) &
1531 & **3*y(4)**2 + 90*y(2)**2*y(3)**3 + 135*y(2)**2*y(3)**2*y(4) + 1445*y(2)**2*y(3) &
1532 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
1533 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
1534 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
1535 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1536 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1537 beta_coef_x(i + 1, 3, &
1538 & 5) = (4*y(4)**2*(5*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 &
1539 & + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 205*y(2)*y(3)*y(4)**2 + 100*y(2)*y(4) &
1540 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
1541 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
1542 & + y(4))**2)
1543
1544 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1545 beta_coef_x(i + 1, 2, &
1546 & 0) = (4*y(3)**2*(5*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 &
1547 & + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 205*y(1)*y(2)*y(3)**2 + 100*y(1)*y(3) &
1548 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
1549 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
1550 & + y(4))**2)
1551 beta_coef_x(i + 1, 2, &
1552 & 1) = (4*y(3)**2*(5*y(1)**3*y(2)*y(3) + 10*y(1)**3*y(2)*y(4) - 95*y(1)**3*y(3)**2 &
1553 & + 5*y(1)**3*y(3)*y(4) + 20*y(1)**2*y(2)**2*y(3) + 40*y(1)**2*y(2)**2*y(4) &
1554 & - 465*y(1)**2*y(2)*y(3)**2 + 55*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 &
1555 & - 285*y(1)**2*y(3)**3 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 &
1556 & + 30*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) - 825*y(1)*y(2)**2*y(3)**2 &
1557 & + 135*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 - 1040*y(1)*y(2)*y(3)**3 &
1558 & + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 - 1847*y(1)*y(3)**4 &
1559 & + 125*y(1)*y(3)**3*y(4) + 110*y(1)*y(3)**2*y(4)**2 + 15*y(2)**4*y(3) + 30*y(2) &
1560 & **4*y(4) - 550*y(2)**3*y(3)**2 + 90*y(2)**3*y(3)*y(4) + 20*y(2)**3*y(4)**2 &
1561 & - 1040*y(2)**2*y(3)**3 + 100*y(2)**2*y(3)**2*y(4) + 35*y(2)**2*y(3)*y(4)**2 &
1562 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
1563 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
1564 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
1565 & **2)
1566 beta_coef_x(i + 1, 2, &
1567 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
1568 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
1569 & + 5*y(1)*y(2)**2*y(3) + 10*y(1)*y(2)**2*y(4) + 100*y(1)*y(3)**2*y(4) + 205*y(2) &
1570 & *y(3)**2*y(4) + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
1571 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1572 & + y(4))**2)
1573 beta_coef_x(i + 1, 2, &
1574 & 3) = (4*y(3)**2*(50*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 &
1575 & + 300*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 30*y(1)**3*y(2)*y(4)**2 &
1576 & + 200*y(1)**3*y(3)**3 + 25*y(1)**3*y(3)**2*y(4) + 35*y(1)**3*y(3)*y(4)**2 &
1577 & + 10*y(1)**3*y(4)**3 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
1578 & + 75*y(1)**2*y(2)**2*y(4)**2 + 1000*y(1)**2*y(2)*y(3)**3 + 125*y(1)**2*y(2)*y(3) &
1579 & **2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 50*y(1)**2*y(2)*y(4)**3 + 1081*y(1) &
1580 & **2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1) &
1581 & **2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 900*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2) &
1582 & **3*y(3)*y(4) + 90*y(1)*y(2)**3*y(4)**2 + 1800*y(1)*y(2)**2*y(3)**3 + 225*y(1) &
1583 & *y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 + 90*y(1)*y(2)**2*y(4)**3 &
1584 & + 4224*y(1)*y(2)*y(3)**4 - 120*y(1)*y(2)*y(3)**3*y(4) + 25*y(1)*y(2)*y(3)**2*y(4) &
1585 & **2 + 165*y(1)*y(2)*y(3)*y(4)**3 + 20*y(1)*y(2)*y(4)**4 + 3324*y(1)*y(3)**5 &
1586 & + 1407*y(1)*y(3)**4*y(4) - 100*y(1)*y(3)**3*y(4)**2 + 70*y(1)*y(3)**2*y(4)**3 &
1587 & + 15*y(1)*y(3)*y(4)**4 + 450*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 45*y(2) &
1588 & **4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 150*y(2)**3*y(3)**2*y(4) + 210*y(2)**3*y(3) &
1589 & *y(4)**2 + 60*y(2)**3*y(4)**3 + 4224*y(2)**2*y(3)**4 - 120*y(2)**2*y(3)**3*y(4) &
1590 & + 25*y(2)**2*y(3)**2*y(4)**2 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 &
1591 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
1592 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
1593 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
1594 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1595 & + y(3) + y(4))**2)
1596 beta_coef_x(i + 1, 2, &
1597 & 4) = -(4*y(3)**2*(100*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 10*y(1) &
1598 & **2*y(2)*y(4)**2 - 95*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 300*y(1) &
1599 & *y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 + 200*y(1) &
1600 & *y(2)*y(3)**3 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1) &
1601 & *y(2)*y(4)**3 + 1562*y(1)*y(3)**4 - 190*y(1)*y(3)**3*y(4) + 15*y(1)*y(3)**2*y(4) &
1602 & **2 + 5*y(1)*y(3)*y(4)**3 + 300*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 30*y(2) &
1603 & **3*y(4)**2 + 400*y(2)**2*y(3)**3 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3) &
1604 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
1605 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
1606 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
1607 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
1608 & **2)
1609 beta_coef_x(i + 1, 2, &
1610 & 5) = (4*y(3)**2*(50*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 5*y(2)**2*y(4)**2 &
1611 & - 95*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 781*y(3)**4 + 50*y(3)**2*y(4)**2)) &
1612 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
1613
1614 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1615 beta_coef_x(i + 1, 1, &
1616 & 0) = (4*y(2)**2*(50*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 5*y(1)**2*y(3)**2 &
1617 & - 95*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 781*y(2)**4 + 50*y(2)**2*y(3)**2)) &
1618 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1619 beta_coef_x(i + 1, 1, &
1620 & 1) = -(4*y(2)**2*(105*y(1)**3*y(2)**2 + 25*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2) &
1621 & *y(4) + 20*y(1)**3*y(3)**2 + 10*y(1)**3*y(3)*y(4) + 110*y(1)**2*y(2)**3 - 35*y(1) &
1622 & **2*y(2)**2*y(3) + 15*y(1)**2*y(2)**2*y(4) + 85*y(1)**2*y(2)*y(3)**2 + 50*y(1) &
1623 & **2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1) &
1624 & **2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 + 1467*y(1)*y(2)**4 - 460*y(1)*y(2) &
1625 & **3*y(3) - 190*y(1)*y(2)**3*y(4) - 235*y(1)*y(2)**2*y(3)**2 - 260*y(1)*y(2) &
1626 & **2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2) &
1627 & *y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 3124*y(2)**5 + 3224*y(2)**4*y(3) &
1628 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
1629 & **2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2))/(5*(y(2) &
1630 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1631 & + y(3) + y(4))**2)
1632 beta_coef_x(i + 1, 1, &
1633 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
1634 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
1635 & + 205*y(1)*y(2)**2*y(3) + 100*y(1)*y(2)**2*y(4) + 10*y(1)*y(3)**2*y(4) + 5*y(2) &
1636 & *y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
1637 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1638 & + y(4))**2)
1639 beta_coef_x(i + 1, 1, &
1640 & 3) = (4*y(2)**2*(60*y(1)**4*y(2)**2 + 30*y(1)**4*y(2)*y(3) + 15*y(1)**4*y(2)*y(4) &
1641 & + 20*y(1)**4*y(3)**2 + 20*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 135*y(1) &
1642 & **3*y(2)**3 + 140*y(1)**3*y(2)**2*y(3) + 70*y(1)**3*y(2)**2*y(4) + 165*y(1) &
1643 & **3*y(2)*y(3)**2 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1) &
1644 & **3*y(3)**3 + 90*y(1)**3*y(3)**2*y(4) + 50*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4) &
1645 & **3 + 771*y(1)**2*y(2)**4 - 200*y(1)**2*y(2)**3*y(3) - 100*y(1)**2*y(2)**3*y(4) &
1646 & + 25*y(1)**2*y(2)**2*y(3)**2 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2) &
1647 & **2*y(4)**2 + 210*y(1)**2*y(2)*y(3)**3 + 315*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1) &
1648 & **2*y(2)*y(3)*y(4)**2 + 35*y(1)**2*y(2)*y(4)**3 + 45*y(1)**2*y(3)**4 + 90*y(1) &
1649 & **2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1) &
1650 & **2*y(4)**4 + 3039*y(1)*y(2)**5 + 2814*y(1)*y(2)**4*y(3) + 1407*y(1)*y(2)**4*y(4) &
1651 & - 120*y(1)*y(2)**3*y(3)**2 - 120*y(1)*y(2)**3*y(3)*y(4) - 50*y(1)*y(2)**3*y(4) &
1652 & **2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 125*y(1)*y(2) &
1653 & **2*y(3)*y(4)**2 + 25*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2) &
1654 & *y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1) &
1655 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
1656 & **4*y(3)**2 + 4224*y(2)**4*y(3)*y(4) + 1081*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3) &
1657 & **3 + 1800*y(2)**3*y(3)**2*y(4) + 1000*y(2)**3*y(3)*y(4)**2 + 200*y(2)**3*y(4) &
1658 & **3 + 450*y(2)**2*y(3)**4 + 900*y(2)**2*y(3)**3*y(4) + 750*y(2)**2*y(3)**2*y(4) &
1659 & **2 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) &
1660 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1661 beta_coef_x(i + 1, 1, &
1662 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
1663 & **2*y(2)**2*y(4) + 35*y(1)**2*y(2)*y(3)**2 + 35*y(1)**2*y(2)*y(3)*y(4) + 5*y(1) &
1664 & **2*y(2)*y(4)**2 + 20*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3) &
1665 & *y(4)**2 - 1452*y(1)*y(2)**4 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) &
1666 & + 100*y(1)*y(2)**2*y(3)**2 + 100*y(1)*y(2)**2*y(3)*y(4) + 20*y(1)*y(2)**2*y(4) &
1667 & **2 + 90*y(1)*y(2)*y(3)**3 + 135*y(1)*y(2)*y(3)**2*y(4) + 55*y(1)*y(2)*y(3)*y(4) &
1668 & **2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3) &
1669 & **2*y(4)**2 + 10*y(1)*y(3)*y(4)**3 - 3219*y(2)**5 - 3694*y(2)**4*y(3) - 1847*y(2) &
1670 & **4*y(4) - 1040*y(2)**3*y(3)**2 - 1040*y(2)**3*y(3)*y(4) - 285*y(2)**3*y(4)**2 &
1671 & - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) - 465*y(2)**2*y(3)*y(4)**2 &
1672 & - 95*y(2)**2*y(4)**3 + 15*y(2)*y(3)**4 + 30*y(2)*y(3)**3*y(4) + 20*y(2)*y(3) &
1673 & **2*y(4)**2 + 5*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1674 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1675 beta_coef_x(i + 1, 1, &
1676 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
1677 & **2*y(3)**2 + 205*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 &
1678 & + 15*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) &
1679 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1680 & + y(3) + y(4))**2)
1681
1682 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1683 beta_coef_x(i + 1, 0, &
1684 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
1685 & **2*y(2)**2 + 205*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 &
1686 & + 15*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 5*y(2)**4 + 10*y(2)**3*y(3) &
1687 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1688 & + y(3) + y(4))**2)
1689 beta_coef_x(i + 1, 0, &
1690 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
1691 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
1692 & **3*y(2)*y(4) + 700*y(1)**3*y(3)**2 + 500*y(1)**3*y(3)*y(4) + 100*y(1)**3*y(4) &
1693 & **2 + 1060*y(1)**2*y(2)**3 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) &
1694 & + 1445*y(1)**2*y(2)*y(3)**2 + 1030*y(1)**2*y(2)*y(3)*y(4) + 205*y(1)**2*y(2)*y(4) &
1695 & **2 + 300*y(1)**2*y(3)**3 + 300*y(1)**2*y(3)**2*y(4) + 100*y(1)**2*y(3)*y(4)**2 &
1696 & + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2) &
1697 & **2*y(3)**2 + 90*y(1)*y(2)**2*y(3)*y(4) + 15*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2) &
1698 & *y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 30*y(2)**5 &
1699 & + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 + 60*y(2)**3*y(3)*y(4) &
1700 & + 10*y(2)**3*y(4)**2 + 30*y(2)**2*y(3)**3 + 30*y(2)**2*y(3)**2*y(4) + 10*y(2) &
1701 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1702 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1703 beta_coef_x(i + 1, 0, &
1704 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
1705 & *y(1)**3 + 665*y(1)**2*y(2)**2 + 775*y(1)**2*y(2)*y(3) + 220*y(4)*y(1)**2*y(2) &
1706 & + 215*y(1)**2*y(3)**2 + 110*y(4)*y(1)**2*y(3) + 75*y(1)*y(2)**3 + 130*y(1)*y(2) &
1707 & **2*y(3) + 35*y(4)*y(1)*y(2)**2 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) &
1708 & + 5*y(1)*y(3)**3 + 5*y(4)*y(1)*y(3)**2 + 30*y(2)**4 + 70*y(2)**3*y(3) + 20*y(4) &
1709 & *y(2)**3 + 50*y(2)**2*y(3)**2 + 30*y(4)*y(2)**2*y(3) + 10*y(2)*y(3)**3 + 10*y(4) &
1710 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
1711 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1712 beta_coef_x(i + 1, 0, &
1713 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
1714 & **5*y(4) + 4884*y(1)**4*y(2)**2 + 9058*y(1)**4*y(2)*y(3) + 4529*y(1)**4*y(2)*y(4) &
1715 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
1716 & + 2565*y(1)**3*y(2)**3 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) &
1717 & + 4755*y(1)**3*y(2)*y(3)**2 + 4755*y(1)**3*y(2)*y(3)*y(4) + 1315*y(1)**3*y(2) &
1718 & *y(4)**2 + 1200*y(1)**3*y(3)**3 + 1800*y(1)**3*y(3)**2*y(4) + 1000*y(1)**3*y(3) &
1719 & *y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 + 4380*y(1)**2*y(2)**3*y(3) &
1720 & + 2190*y(1)**2*y(2)**3*y(4) + 5025*y(1)**2*y(2)**2*y(3)**2 + 5025*y(1)**2*y(2) &
1721 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
1722 & + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 415*y(1) &
1723 & **2*y(2)*y(4)**3 + 450*y(1)**2*y(3)**4 + 900*y(1)**2*y(3)**3*y(4) + 750*y(1) &
1724 & **2*y(3)**2*y(4)**2 + 300*y(1)**2*y(3)*y(4)**3 + 50*y(1)**2*y(4)**4 + 135*y(1) &
1725 & *y(2)**5 + 450*y(1)*y(2)**4*y(3) + 225*y(1)*y(2)**4*y(4) + 540*y(1)*y(2)**3*y(3) &
1726 & **2 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2) &
1727 & **2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 225*y(1)*y(2)**2*y(3)*y(4)**2 &
1728 & + 45*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) &
1729 & + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 &
1730 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
1731 & + 270*y(2)**4*y(3)*y(4) + 75*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2) &
1732 & **3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 + 45*y(2) &
1733 & **2*y(3)**4 + 90*y(2)**2*y(3)**3*y(4) + 75*y(2)**2*y(3)**2*y(4)**2 + 30*y(2) &
1734 & **2*y(3)*y(4)**3 + 5*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3)) &
1735 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1736 beta_coef_x(i + 1, 0, &
1737 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
1738 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
1739 & **3*y(2)*y(4) + 1460*y(1)**3*y(3)**2 + 1460*y(1)**3*y(3)*y(4) + 415*y(1)**3*y(4) &
1740 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
1741 & **2*y(4) + 2850*y(1)**2*y(2)*y(3)**2 + 2850*y(1)**2*y(2)*y(3)*y(4) + 790*y(1) &
1742 & **2*y(2)*y(4)**2 + 650*y(1)**2*y(3)**3 + 975*y(1)**2*y(3)**2*y(4) + 535*y(1) &
1743 & **2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 + 720*y(1)*y(2)**3*y(3) &
1744 & + 360*y(1)*y(2)**3*y(4) + 645*y(1)*y(2)**2*y(3)**2 + 645*y(1)*y(2)**2*y(3)*y(4) &
1745 & + 165*y(1)*y(2)**2*y(4)**2 + 210*y(1)*y(2)*y(3)**3 + 315*y(1)*y(2)*y(3)**2*y(4) &
1746 & + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 + 30*y(1) &
1747 & *y(3)**3*y(4) + 20*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 90*y(2)**5 &
1748 & + 300*y(2)**4*y(3) + 150*y(2)**4*y(4) + 360*y(2)**3*y(3)**2 + 360*y(2)**3*y(3) &
1749 & *y(4) + 90*y(2)**3*y(4)**2 + 180*y(2)**2*y(3)**3 + 270*y(2)**2*y(3)**2*y(4) &
1750 & + 130*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3) &
1751 & **3*y(4) + 40*y(2)*y(3)**2*y(4)**2 + 10*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2)) &
1752 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1753 & + y(4))**2)
1754 beta_coef_x(i + 1, 0, &
1755 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
1756 & **3*y(4) + 600*y(1)**2*y(2)**2 + 800*y(1)**2*y(2)*y(3) + 400*y(1)**2*y(2)*y(4) &
1757 & + 260*y(1)**2*y(3)**2 + 260*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 135*y(1) &
1758 & *y(2)**3 + 270*y(1)*y(2)**2*y(3) + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 &
1759 & + 165*y(1)*y(2)*y(3)*y(4) + 30*y(1)*y(2)*y(4)**2 + 30*y(1)*y(3)**3 + 45*y(1)*y(3) &
1760 & **2*y(4) + 15*y(1)*y(3)*y(4)**2 + 45*y(2)**4 + 120*y(2)**3*y(3) + 60*y(2)**3*y(4) &
1761 & + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3) &
1762 & **3 + 60*y(2)*y(3)**2*y(4) + 20*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) &
1763 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1764 & + y(3) + y(4))**2)
1765 end do
1766 else
1767 ! (Fu, et al., 2016) Table 2 (for right flux)
1768 d_cbl_x(0,:) = 18._wp/35._wp
1769 d_cbl_x(1,:) = 3._wp/35._wp
1770 d_cbl_x(2,:) = 9._wp/35._wp
1771 d_cbl_x(3,:) = 1._wp/35._wp
1772 d_cbl_x(4,:) = 4._wp/35._wp
1773
1774 d_cbr_x(0,:) = 18._wp/35._wp
1775 d_cbr_x(1,:) = 9._wp/35._wp
1776 d_cbr_x(2,:) = 3._wp/35._wp
1777 d_cbr_x(3,:) = 4._wp/35._wp
1778 d_cbr_x(4,:) = 1._wp/35._wp
1779 end if
1780 end if
1781 end if
1782# 192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1783 ! Computing WENO3 Coefficients
1784 if (weno_dir == 2) then
1785 if (weno_order == 3) then
1786 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1787 ! Polynomial reconstruction coefficients
1788 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1789 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1790
1791 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1792 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1793
1794 ! Ideal (linear) weights
1795 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1796 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1797
1798 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1799 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1800
1801 ! Smoothness indicator coefficients
1802 beta_coef_y(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
1803 beta_coef_y(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
1804 end do
1805
1806 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1807 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1808 if (null_weights) then
1809 if (bc_s%beg == bc_riemann_extrap) then
1810 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1811 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1812 end if
1813
1814 if (bc_s%end == bc_riemann_extrap) then
1815 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1816 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1817 end if
1818 end if
1819 ! END: Computing WENO3 Coefficients
1820
1821 ! Computing WENO5 Coefficients
1822 else if (weno_order == 5) then
1823 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1824 ! Polynomial reconstruction coefficients
1825 poly_coef_cbr_y(i + 1, 0, &
1826 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1827 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1828 poly_coef_cbr_y(i + 1, 1, &
1829 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1830 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1831 poly_coef_cbr_y(i + 1, 1, &
1832 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1833 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1834 poly_coef_cbr_y(i + 1, 2, &
1835 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1836 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1837 poly_coef_cbl_y(i + 1, 0, &
1838 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1839 & *(s_cb(i + 3) - s_cb(i + 1)))
1840 poly_coef_cbl_y(i + 1, 1, &
1841 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1842 & + 2))*(s_cb(i) - s_cb(i + 2)))
1843 poly_coef_cbl_y(i + 1, 1, &
1844 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1845 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1846 poly_coef_cbl_y(i + 1, 2, &
1847 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1848 & *(s_cb(i - 2) - s_cb(i + 1)))
1849
1850 poly_coef_cbr_y(i + 1, 0, &
1851 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1852 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1853 poly_coef_cbr_y(i + 1, 2, &
1854 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1855 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1856 poly_coef_cbl_y(i + 1, 0, &
1857 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1858 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1859 poly_coef_cbl_y(i + 1, 2, &
1860 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1861 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1862
1863 ! Ideal (linear) weights
1864 d_cbr_y(0, &
1865 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1866 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1867 d_cbr_y(2, &
1868 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1869 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1870 d_cbl_y(0, &
1871 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1872 & *(s_cb(i + 3) - s_cb(i - 1)))
1873 d_cbl_y(2, &
1874 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1875 & *(s_cb(i - 2) - s_cb(i + 3)))
1876
1877 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1878 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1879
1880 ! Smoothness indicator coefficients
1881 beta_coef_y(i + 1, 0, &
1882 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1883 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1884 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1885
1886 beta_coef_y(i + 1, 0, &
1887 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1888 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1889 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1890 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1891
1892 beta_coef_y(i + 1, 0, &
1893 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1894 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1895 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1896 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1897
1898 beta_coef_y(i + 1, 1, &
1899 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1900 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1901 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1902
1903 beta_coef_y(i + 1, 1, &
1904 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1905 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1906 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1907 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1908
1909 beta_coef_y(i + 1, 1, &
1910 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1911 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1912 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1913
1914 beta_coef_y(i + 1, 2, &
1915 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1916 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1917 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1918 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1919
1920 beta_coef_y(i + 1, 2, &
1921 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1922 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1923 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1924 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1925
1926 beta_coef_y(i + 1, 2, &
1927 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1928 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1929 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1930 end do
1931
1932 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1933 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1934 if (null_weights) then
1935 if (bc_s%beg == bc_riemann_extrap) then
1936 d_cbr_y(1:2,0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1937 d_cbl_y(1:2,0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1938 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:,1) = d_cbr_y(:,1)/sum(d_cbr_y(:,1))
1939 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:,1) = d_cbl_y(:,1)/sum(d_cbl_y(:,1))
1940 end if
1941
1942 if (bc_s%end == bc_riemann_extrap) then
1943 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:,s - 1) = d_cbr_y(:, &
1944 & s - 1)/sum(d_cbr_y(:,s - 1))
1945 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:,s - 1) = d_cbl_y(:, &
1946 & s - 1)/sum(d_cbl_y(:,s - 1))
1947 d_cbr_y(0:1,s) = 0._wp; d_cbr_y(2, s) = 1._wp
1948 d_cbl_y(0:1,s) = 0._wp; d_cbl_y(2, s) = 1._wp
1949 end if
1950 end if
1951 else
1952 if (.not. teno) then
1953 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1954 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1955 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1956 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1957 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1958 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1959 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1960 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1961 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1962 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1963 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1964 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1965
1966 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1967 d_cbr_y(0, &
1968 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1969 & *(w(1) - w(8)))
1970 d_cbr_y(1, &
1971 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1972 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
1973 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1974 & *(w(2) - w(8)))
1975 d_cbr_y(2, &
1976 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1977 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
1978 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1979 & *(w(3) - w(8)))
1980 d_cbr_y(3, &
1981 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1982 & *(w(3) - w(8)))
1983
1984 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
1985 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
1986 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
1987 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
1988 w(1) = s_cb(i + 4) - s_cb(i)
1989 w(2) = s_cb(i + 3) - s_cb(i)
1990 w(3) = s_cb(i + 2) - s_cb(i)
1991 w(4) = s_cb(i + 1) - s_cb(i)
1992 w(5) = s_cb(i) - s_cb(i)
1993 w(6) = s_cb(i - 1) - s_cb(i)
1994 w(7) = s_cb(i - 2) - s_cb(i)
1995 w(8) = s_cb(i - 3) - s_cb(i)
1996 d_cbl_y(0, &
1997 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1998 & *(w(3) - w(8)))
1999 d_cbl_y(1, &
2000 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2001 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
2002 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2003 & *(w(3) - w(8)))
2004 d_cbl_y(2, &
2005 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2006 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
2007 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2008 & *(w(2) - w(8)))
2009 d_cbl_y(3, &
2010 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2011 & *(w(1) - w(8)))
2012 ! Note: Left has the reversed order of both points and coefficients compared to the right
2013
2014 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2015 poly_coef_cbr_y(i + 1, 0, &
2016 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2017 & + y(2) + y(3) + y(4)))
2018 poly_coef_cbr_y(i + 1, 0, &
2019 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2020 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2021 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2022 poly_coef_cbr_y(i + 1, 0, &
2023 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2024 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2025 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2026
2027 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2028 poly_coef_cbr_y(i + 1, 1, &
2029 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2030 & + y(2) + y(3) + y(4)))
2031 poly_coef_cbr_y(i + 1, 1, &
2032 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2033 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2034 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2035 poly_coef_cbr_y(i + 1, 1, &
2036 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2037 & + y(2) + y(3) + y(4)))
2038
2039 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2040 poly_coef_cbr_y(i + 1, 2, &
2041 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2042 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2043 poly_coef_cbr_y(i + 1, 2, &
2044 & 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2045 & + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) &
2046 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2047 poly_coef_cbr_y(i + 1, 2, &
2048 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2049 & + y(2) + y(3) + y(4)))
2050
2051 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2052 poly_coef_cbr_y(i + 1, 3, &
2053 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2054 & + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) &
2055 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2056 poly_coef_cbr_y(i + 1, 3, &
2057 & 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) &
2058 & + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2)) &
2059 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2060 & + y(4)))
2061 poly_coef_cbr_y(i + 1, 3, &
2062 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2063 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2064
2065 ! Element-wise: see the no-reversed-sections note above.
2066 y(1) = s_cb(i + 1) - s_cb(i)
2067 y(2) = s_cb(i) - s_cb(i - 1)
2068 y(3) = s_cb(i - 1) - s_cb(i - 2)
2069 y(4) = s_cb(i - 2) - s_cb(i - 3)
2070 poly_coef_cbl_y(i + 1, 3, &
2071 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2072 & + y(2) + y(3) + y(4)))
2073 poly_coef_cbl_y(i + 1, 3, &
2074 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2075 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2076 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2077 poly_coef_cbl_y(i + 1, 3, &
2078 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2079 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2080 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2081
2082 ! Element-wise: see the no-reversed-sections note above.
2083 y(1) = s_cb(i + 2) - s_cb(i + 1)
2084 y(2) = s_cb(i + 1) - s_cb(i)
2085 y(3) = s_cb(i) - s_cb(i - 1)
2086 y(4) = s_cb(i - 1) - s_cb(i - 2)
2087 poly_coef_cbl_y(i + 1, 2, &
2088 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2089 & + y(2) + y(3) + y(4)))
2090 poly_coef_cbl_y(i + 1, 2, &
2091 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2092 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2093 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2094 poly_coef_cbl_y(i + 1, 2, &
2095 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2096 & + y(2) + y(3) + y(4)))
2097
2098 ! Element-wise: see the no-reversed-sections note above.
2099 y(1) = s_cb(i + 3) - s_cb(i + 2)
2100 y(2) = s_cb(i + 2) - s_cb(i + 1)
2101 y(3) = s_cb(i + 1) - s_cb(i)
2102 y(4) = s_cb(i) - s_cb(i - 1)
2103 poly_coef_cbl_y(i + 1, 1, &
2104 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2105 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2106 poly_coef_cbl_y(i + 1, 1, &
2107 & 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2108 & + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) &
2109 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2110 poly_coef_cbl_y(i + 1, 1, &
2111 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2112 & + y(2) + y(3) + y(4)))
2113
2114 ! Element-wise: see the no-reversed-sections note above.
2115 y(1) = s_cb(i + 4) - s_cb(i + 3)
2116 y(2) = s_cb(i + 3) - s_cb(i + 2)
2117 y(3) = s_cb(i + 2) - s_cb(i + 1)
2118 y(4) = s_cb(i + 1) - s_cb(i)
2119 poly_coef_cbl_y(i + 1, 0, &
2120 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2121 & + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) &
2122 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2123 poly_coef_cbl_y(i + 1, 0, &
2124 & 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) &
2125 & + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2)) &
2126 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2127 & + y(4)))
2128 poly_coef_cbl_y(i + 1, 0, &
2129 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2130 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2131
2132 poly_coef_cbl_y(i + 1,:,:) = -poly_coef_cbl_y(i + 1,:,:)
2133 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2134
2135 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2136 beta_coef_y(i + 1, 3, &
2137 & 0) = (4*y(4)**2*(5*y(1)**2*y(2)**2 + 20*y(1)**2*y(2)*y(3) + 15*y(1)**2*y(2)*y(4) &
2138 & + 20*y(1)**2*y(3)**2 + 30*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 10*y(1)*y(2) &
2139 & **3 + 60*y(1)*y(2)**2*y(3) + 45*y(1)*y(2)**2*y(4) + 110*y(1)*y(2)*y(3)**2 &
2140 & + 165*y(1)*y(2)*y(3)*y(4) + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1) &
2141 & *y(3)**2*y(4) + 400*y(1)*y(3)*y(4)**2 + 225*y(1)*y(4)**3 + 5*y(2)**4 + 40*y(2) &
2142 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2143 & + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3) &
2144 & *y(4)**2 + 450*y(2)*y(4)**3 + 45*y(3)**4 + 135*y(3)**3*y(4) + 600*y(3)**2*y(4) &
2145 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2146 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2147 beta_coef_y(i + 1, 3, &
2148 & 1) = -(4*y(4)**2*(10*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3) &
2149 & **2 + 25*y(1)**3*y(3)*y(4) + 105*y(1)**3*y(4)**2 + 40*y(1)**2*y(2)**2*y(3) &
2150 & + 20*y(1)**2*y(2)**2*y(4) + 130*y(1)**2*y(2)*y(3)**2 + 155*y(1)**2*y(2)*y(3)*y(4) &
2151 & + 535*y(1)**2*y(2)*y(4)**2 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) &
2152 & + 790*y(1)**2*y(3)*y(4)**2 + 415*y(1)**2*y(4)**3 + 60*y(1)*y(2)**3*y(3) + 30*y(1) &
2153 & *y(2)**3*y(4) + 270*y(1)*y(2)**2*y(3)**2 + 315*y(1)*y(2)**2*y(3)*y(4) + 975*y(1) &
2154 & *y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1) &
2155 & *y(2)*y(3)*y(4)**2 + 1460*y(1)*y(2)*y(4)**3 + 150*y(1)*y(3)**4 + 360*y(1)*y(3) &
2156 & **3*y(4) + 2000*y(1)*y(3)**2*y(4)**2 + 2005*y(1)*y(3)*y(4)**3 + 2077*y(1)*y(4) &
2157 & **4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 + 210*y(2)**3*y(3) &
2158 & *y(4) + 650*y(2)**3*y(4)**2 + 360*y(2)**2*y(3)**3 + 645*y(2)**2*y(3)**2*y(4) &
2159 & + 2850*y(2)**2*y(3)*y(4)**2 + 1460*y(2)**2*y(4)**3 + 300*y(2)*y(3)**4 + 720*y(2) &
2160 & *y(3)**3*y(4) + 4000*y(2)*y(3)**2*y(4)**2 + 4010*y(2)*y(3)*y(4)**3 + 4154*y(2) &
2161 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2162 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2163 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2164 beta_coef_y(i + 1, 3, &
2165 & 2) = (4*y(4)**2*(10*y(2)**3*y(3) + 5*y(2)**3*y(4) + 50*y(2)**2*y(3)**2 + 60*y(2) &
2166 & **2*y(3)*y(4) + 10*y(1)*y(2)**2*y(3) + 215*y(2)**2*y(4)**2 + 5*y(1)*y(2)**2*y(4) &
2167 & + 70*y(2)*y(3)**3 + 130*y(2)*y(3)**2*y(4) + 30*y(1)*y(2)*y(3)**2 + 775*y(2)*y(3) &
2168 & *y(4)**2 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 &
2169 & + 30*y(3)**4 + 75*y(3)**3*y(4) + 20*y(1)*y(3)**3 + 665*y(3)**2*y(4)**2 + 35*y(1) &
2170 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2171 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2172 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2173 beta_coef_y(i + 1, 3, &
2174 & 3) = (4*y(4)**2*(5*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 50*y(1)**4*y(4)**2 &
2175 & + 30*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 300*y(1)**3*y(2)*y(4)**2 &
2176 & + 30*y(1)**3*y(3)**3 + 45*y(1)**3*y(3)**2*y(4) + 415*y(1)**3*y(3)*y(4)**2 &
2177 & + 200*y(1)**3*y(4)**3 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2178 & + 750*y(1)**2*y(2)**2*y(4)**2 + 150*y(1)**2*y(2)*y(3)**3 + 225*y(1)**2*y(2)*y(3) &
2179 & **2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 1000*y(1)**2*y(2)*y(4)**3 + 75*y(1) &
2180 & **2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1) &
2181 & **2*y(3)*y(4)**3 + 1081*y(1)**2*y(4)**4 + 90*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2) &
2182 & **3*y(3)*y(4) + 900*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1) &
2183 & *y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 + 1800*y(1)*y(2)**2*y(4) &
2184 & **3 + 270*y(1)*y(2)*y(3)**4 + 540*y(1)*y(2)*y(3)**3*y(4) + 5025*y(1)*y(2)*y(3) &
2185 & **2*y(4)**2 + 4755*y(1)*y(2)*y(3)*y(4)**3 + 4224*y(1)*y(2)*y(4)**4 + 90*y(1)*y(3) &
2186 & **5 + 225*y(1)*y(3)**4*y(4) + 2190*y(1)*y(3)**3*y(4)**2 + 3060*y(1)*y(3)**2*y(4) &
2187 & **3 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2) &
2188 & **4*y(3)*y(4) + 450*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3) &
2189 & **2*y(4) + 2490*y(2)**3*y(3)*y(4)**2 + 1200*y(2)**3*y(4)**3 + 270*y(2)**2*y(3) &
2190 & **4 + 540*y(2)**2*y(3)**3*y(4) + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3) &
2191 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2192 & + 4380*y(2)*y(3)**3*y(4)**2 + 6120*y(2)*y(3)**2*y(4)**3 + 9058*y(2)*y(3)*y(4)**4 &
2193 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2194 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2195 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2196 & + y(3) + y(4))**2)
2197 beta_coef_y(i + 1, 3, &
2198 & 4) = -(4*y(4)**2*(10*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 100*y(1) &
2199 & **2*y(2)*y(4)**2 + 10*y(1)**2*y(3)**3 + 15*y(1)**2*y(3)**2*y(4) + 205*y(1) &
2200 & **2*y(3)*y(4)**2 + 100*y(1)**2*y(4)**3 + 30*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2) &
2201 & **2*y(3)*y(4) + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2) &
2202 & *y(3)**2*y(4) + 1030*y(1)*y(2)*y(3)*y(4)**2 + 500*y(1)*y(2)*y(4)**3 + 30*y(1) &
2203 & *y(3)**4 + 60*y(1)*y(3)**3*y(4) + 835*y(1)*y(3)**2*y(4)**2 + 805*y(1)*y(3)*y(4) &
2204 & **3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 300*y(2) &
2205 & **3*y(4)**2 + 90*y(2)**2*y(3)**3 + 135*y(2)**2*y(3)**2*y(4) + 1445*y(2)**2*y(3) &
2206 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2207 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2208 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2209 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2210 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2211 beta_coef_y(i + 1, 3, &
2212 & 5) = (4*y(4)**2*(5*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 &
2213 & + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 205*y(2)*y(3)*y(4)**2 + 100*y(2)*y(4) &
2214 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2215 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2216 & + y(4))**2)
2217
2218 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2219 beta_coef_y(i + 1, 2, &
2220 & 0) = (4*y(3)**2*(5*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 &
2221 & + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 205*y(1)*y(2)*y(3)**2 + 100*y(1)*y(3) &
2222 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2223 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2224 & + y(4))**2)
2225 beta_coef_y(i + 1, 2, &
2226 & 1) = (4*y(3)**2*(5*y(1)**3*y(2)*y(3) + 10*y(1)**3*y(2)*y(4) - 95*y(1)**3*y(3)**2 &
2227 & + 5*y(1)**3*y(3)*y(4) + 20*y(1)**2*y(2)**2*y(3) + 40*y(1)**2*y(2)**2*y(4) &
2228 & - 465*y(1)**2*y(2)*y(3)**2 + 55*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 &
2229 & - 285*y(1)**2*y(3)**3 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 &
2230 & + 30*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) - 825*y(1)*y(2)**2*y(3)**2 &
2231 & + 135*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 - 1040*y(1)*y(2)*y(3)**3 &
2232 & + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 - 1847*y(1)*y(3)**4 &
2233 & + 125*y(1)*y(3)**3*y(4) + 110*y(1)*y(3)**2*y(4)**2 + 15*y(2)**4*y(3) + 30*y(2) &
2234 & **4*y(4) - 550*y(2)**3*y(3)**2 + 90*y(2)**3*y(3)*y(4) + 20*y(2)**3*y(4)**2 &
2235 & - 1040*y(2)**2*y(3)**3 + 100*y(2)**2*y(3)**2*y(4) + 35*y(2)**2*y(3)*y(4)**2 &
2236 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2237 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2238 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2239 & **2)
2240 beta_coef_y(i + 1, 2, &
2241 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2242 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2243 & + 5*y(1)*y(2)**2*y(3) + 10*y(1)*y(2)**2*y(4) + 100*y(1)*y(3)**2*y(4) + 205*y(2) &
2244 & *y(3)**2*y(4) + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2245 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2246 & + y(4))**2)
2247 beta_coef_y(i + 1, 2, &
2248 & 3) = (4*y(3)**2*(50*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 &
2249 & + 300*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 30*y(1)**3*y(2)*y(4)**2 &
2250 & + 200*y(1)**3*y(3)**3 + 25*y(1)**3*y(3)**2*y(4) + 35*y(1)**3*y(3)*y(4)**2 &
2251 & + 10*y(1)**3*y(4)**3 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2252 & + 75*y(1)**2*y(2)**2*y(4)**2 + 1000*y(1)**2*y(2)*y(3)**3 + 125*y(1)**2*y(2)*y(3) &
2253 & **2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 50*y(1)**2*y(2)*y(4)**3 + 1081*y(1) &
2254 & **2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1) &
2255 & **2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 900*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2) &
2256 & **3*y(3)*y(4) + 90*y(1)*y(2)**3*y(4)**2 + 1800*y(1)*y(2)**2*y(3)**3 + 225*y(1) &
2257 & *y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 + 90*y(1)*y(2)**2*y(4)**3 &
2258 & + 4224*y(1)*y(2)*y(3)**4 - 120*y(1)*y(2)*y(3)**3*y(4) + 25*y(1)*y(2)*y(3)**2*y(4) &
2259 & **2 + 165*y(1)*y(2)*y(3)*y(4)**3 + 20*y(1)*y(2)*y(4)**4 + 3324*y(1)*y(3)**5 &
2260 & + 1407*y(1)*y(3)**4*y(4) - 100*y(1)*y(3)**3*y(4)**2 + 70*y(1)*y(3)**2*y(4)**3 &
2261 & + 15*y(1)*y(3)*y(4)**4 + 450*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 45*y(2) &
2262 & **4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 150*y(2)**3*y(3)**2*y(4) + 210*y(2)**3*y(3) &
2263 & *y(4)**2 + 60*y(2)**3*y(4)**3 + 4224*y(2)**2*y(3)**4 - 120*y(2)**2*y(3)**3*y(4) &
2264 & + 25*y(2)**2*y(3)**2*y(4)**2 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 &
2265 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2266 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2267 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2268 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2269 & + y(3) + y(4))**2)
2270 beta_coef_y(i + 1, 2, &
2271 & 4) = -(4*y(3)**2*(100*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 10*y(1) &
2272 & **2*y(2)*y(4)**2 - 95*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 300*y(1) &
2273 & *y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 + 200*y(1) &
2274 & *y(2)*y(3)**3 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1) &
2275 & *y(2)*y(4)**3 + 1562*y(1)*y(3)**4 - 190*y(1)*y(3)**3*y(4) + 15*y(1)*y(3)**2*y(4) &
2276 & **2 + 5*y(1)*y(3)*y(4)**3 + 300*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 30*y(2) &
2277 & **3*y(4)**2 + 400*y(2)**2*y(3)**3 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3) &
2278 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2279 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2280 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2281 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2282 & **2)
2283 beta_coef_y(i + 1, 2, &
2284 & 5) = (4*y(3)**2*(50*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 5*y(2)**2*y(4)**2 &
2285 & - 95*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 781*y(3)**4 + 50*y(3)**2*y(4)**2)) &
2286 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2287
2288 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2289 beta_coef_y(i + 1, 1, &
2290 & 0) = (4*y(2)**2*(50*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 5*y(1)**2*y(3)**2 &
2291 & - 95*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 781*y(2)**4 + 50*y(2)**2*y(3)**2)) &
2292 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2293 beta_coef_y(i + 1, 1, &
2294 & 1) = -(4*y(2)**2*(105*y(1)**3*y(2)**2 + 25*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2) &
2295 & *y(4) + 20*y(1)**3*y(3)**2 + 10*y(1)**3*y(3)*y(4) + 110*y(1)**2*y(2)**3 - 35*y(1) &
2296 & **2*y(2)**2*y(3) + 15*y(1)**2*y(2)**2*y(4) + 85*y(1)**2*y(2)*y(3)**2 + 50*y(1) &
2297 & **2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1) &
2298 & **2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 + 1467*y(1)*y(2)**4 - 460*y(1)*y(2) &
2299 & **3*y(3) - 190*y(1)*y(2)**3*y(4) - 235*y(1)*y(2)**2*y(3)**2 - 260*y(1)*y(2) &
2300 & **2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2) &
2301 & *y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 3124*y(2)**5 + 3224*y(2)**4*y(3) &
2302 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2303 & **2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2))/(5*(y(2) &
2304 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2305 & + y(3) + y(4))**2)
2306 beta_coef_y(i + 1, 1, &
2307 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2308 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2309 & + 205*y(1)*y(2)**2*y(3) + 100*y(1)*y(2)**2*y(4) + 10*y(1)*y(3)**2*y(4) + 5*y(2) &
2310 & *y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2311 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2312 & + y(4))**2)
2313 beta_coef_y(i + 1, 1, &
2314 & 3) = (4*y(2)**2*(60*y(1)**4*y(2)**2 + 30*y(1)**4*y(2)*y(3) + 15*y(1)**4*y(2)*y(4) &
2315 & + 20*y(1)**4*y(3)**2 + 20*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 135*y(1) &
2316 & **3*y(2)**3 + 140*y(1)**3*y(2)**2*y(3) + 70*y(1)**3*y(2)**2*y(4) + 165*y(1) &
2317 & **3*y(2)*y(3)**2 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1) &
2318 & **3*y(3)**3 + 90*y(1)**3*y(3)**2*y(4) + 50*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4) &
2319 & **3 + 771*y(1)**2*y(2)**4 - 200*y(1)**2*y(2)**3*y(3) - 100*y(1)**2*y(2)**3*y(4) &
2320 & + 25*y(1)**2*y(2)**2*y(3)**2 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2) &
2321 & **2*y(4)**2 + 210*y(1)**2*y(2)*y(3)**3 + 315*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1) &
2322 & **2*y(2)*y(3)*y(4)**2 + 35*y(1)**2*y(2)*y(4)**3 + 45*y(1)**2*y(3)**4 + 90*y(1) &
2323 & **2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1) &
2324 & **2*y(4)**4 + 3039*y(1)*y(2)**5 + 2814*y(1)*y(2)**4*y(3) + 1407*y(1)*y(2)**4*y(4) &
2325 & - 120*y(1)*y(2)**3*y(3)**2 - 120*y(1)*y(2)**3*y(3)*y(4) - 50*y(1)*y(2)**3*y(4) &
2326 & **2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 125*y(1)*y(2) &
2327 & **2*y(3)*y(4)**2 + 25*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2) &
2328 & *y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1) &
2329 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2330 & **4*y(3)**2 + 4224*y(2)**4*y(3)*y(4) + 1081*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3) &
2331 & **3 + 1800*y(2)**3*y(3)**2*y(4) + 1000*y(2)**3*y(3)*y(4)**2 + 200*y(2)**3*y(4) &
2332 & **3 + 450*y(2)**2*y(3)**4 + 900*y(2)**2*y(3)**3*y(4) + 750*y(2)**2*y(3)**2*y(4) &
2333 & **2 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) &
2334 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2335 beta_coef_y(i + 1, 1, &
2336 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2337 & **2*y(2)**2*y(4) + 35*y(1)**2*y(2)*y(3)**2 + 35*y(1)**2*y(2)*y(3)*y(4) + 5*y(1) &
2338 & **2*y(2)*y(4)**2 + 20*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3) &
2339 & *y(4)**2 - 1452*y(1)*y(2)**4 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) &
2340 & + 100*y(1)*y(2)**2*y(3)**2 + 100*y(1)*y(2)**2*y(3)*y(4) + 20*y(1)*y(2)**2*y(4) &
2341 & **2 + 90*y(1)*y(2)*y(3)**3 + 135*y(1)*y(2)*y(3)**2*y(4) + 55*y(1)*y(2)*y(3)*y(4) &
2342 & **2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3) &
2343 & **2*y(4)**2 + 10*y(1)*y(3)*y(4)**3 - 3219*y(2)**5 - 3694*y(2)**4*y(3) - 1847*y(2) &
2344 & **4*y(4) - 1040*y(2)**3*y(3)**2 - 1040*y(2)**3*y(3)*y(4) - 285*y(2)**3*y(4)**2 &
2345 & - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) - 465*y(2)**2*y(3)*y(4)**2 &
2346 & - 95*y(2)**2*y(4)**3 + 15*y(2)*y(3)**4 + 30*y(2)*y(3)**3*y(4) + 20*y(2)*y(3) &
2347 & **2*y(4)**2 + 5*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2348 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2349 beta_coef_y(i + 1, 1, &
2350 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2351 & **2*y(3)**2 + 205*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 &
2352 & + 15*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) &
2353 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2354 & + y(3) + y(4))**2)
2355
2356 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2357 beta_coef_y(i + 1, 0, &
2358 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2359 & **2*y(2)**2 + 205*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 &
2360 & + 15*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 5*y(2)**4 + 10*y(2)**3*y(3) &
2361 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2362 & + y(3) + y(4))**2)
2363 beta_coef_y(i + 1, 0, &
2364 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2365 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2366 & **3*y(2)*y(4) + 700*y(1)**3*y(3)**2 + 500*y(1)**3*y(3)*y(4) + 100*y(1)**3*y(4) &
2367 & **2 + 1060*y(1)**2*y(2)**3 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) &
2368 & + 1445*y(1)**2*y(2)*y(3)**2 + 1030*y(1)**2*y(2)*y(3)*y(4) + 205*y(1)**2*y(2)*y(4) &
2369 & **2 + 300*y(1)**2*y(3)**3 + 300*y(1)**2*y(3)**2*y(4) + 100*y(1)**2*y(3)*y(4)**2 &
2370 & + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2) &
2371 & **2*y(3)**2 + 90*y(1)*y(2)**2*y(3)*y(4) + 15*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2) &
2372 & *y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 30*y(2)**5 &
2373 & + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 + 60*y(2)**3*y(3)*y(4) &
2374 & + 10*y(2)**3*y(4)**2 + 30*y(2)**2*y(3)**3 + 30*y(2)**2*y(3)**2*y(4) + 10*y(2) &
2375 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2376 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2377 beta_coef_y(i + 1, 0, &
2378 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2379 & *y(1)**3 + 665*y(1)**2*y(2)**2 + 775*y(1)**2*y(2)*y(3) + 220*y(4)*y(1)**2*y(2) &
2380 & + 215*y(1)**2*y(3)**2 + 110*y(4)*y(1)**2*y(3) + 75*y(1)*y(2)**3 + 130*y(1)*y(2) &
2381 & **2*y(3) + 35*y(4)*y(1)*y(2)**2 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) &
2382 & + 5*y(1)*y(3)**3 + 5*y(4)*y(1)*y(3)**2 + 30*y(2)**4 + 70*y(2)**3*y(3) + 20*y(4) &
2383 & *y(2)**3 + 50*y(2)**2*y(3)**2 + 30*y(4)*y(2)**2*y(3) + 10*y(2)*y(3)**3 + 10*y(4) &
2384 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2385 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2386 beta_coef_y(i + 1, 0, &
2387 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2388 & **5*y(4) + 4884*y(1)**4*y(2)**2 + 9058*y(1)**4*y(2)*y(3) + 4529*y(1)**4*y(2)*y(4) &
2389 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2390 & + 2565*y(1)**3*y(2)**3 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) &
2391 & + 4755*y(1)**3*y(2)*y(3)**2 + 4755*y(1)**3*y(2)*y(3)*y(4) + 1315*y(1)**3*y(2) &
2392 & *y(4)**2 + 1200*y(1)**3*y(3)**3 + 1800*y(1)**3*y(3)**2*y(4) + 1000*y(1)**3*y(3) &
2393 & *y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 + 4380*y(1)**2*y(2)**3*y(3) &
2394 & + 2190*y(1)**2*y(2)**3*y(4) + 5025*y(1)**2*y(2)**2*y(3)**2 + 5025*y(1)**2*y(2) &
2395 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2396 & + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 415*y(1) &
2397 & **2*y(2)*y(4)**3 + 450*y(1)**2*y(3)**4 + 900*y(1)**2*y(3)**3*y(4) + 750*y(1) &
2398 & **2*y(3)**2*y(4)**2 + 300*y(1)**2*y(3)*y(4)**3 + 50*y(1)**2*y(4)**4 + 135*y(1) &
2399 & *y(2)**5 + 450*y(1)*y(2)**4*y(3) + 225*y(1)*y(2)**4*y(4) + 540*y(1)*y(2)**3*y(3) &
2400 & **2 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2) &
2401 & **2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 225*y(1)*y(2)**2*y(3)*y(4)**2 &
2402 & + 45*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) &
2403 & + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 &
2404 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2405 & + 270*y(2)**4*y(3)*y(4) + 75*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2) &
2406 & **3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 + 45*y(2) &
2407 & **2*y(3)**4 + 90*y(2)**2*y(3)**3*y(4) + 75*y(2)**2*y(3)**2*y(4)**2 + 30*y(2) &
2408 & **2*y(3)*y(4)**3 + 5*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3)) &
2409 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2410 beta_coef_y(i + 1, 0, &
2411 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
2412 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
2413 & **3*y(2)*y(4) + 1460*y(1)**3*y(3)**2 + 1460*y(1)**3*y(3)*y(4) + 415*y(1)**3*y(4) &
2414 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
2415 & **2*y(4) + 2850*y(1)**2*y(2)*y(3)**2 + 2850*y(1)**2*y(2)*y(3)*y(4) + 790*y(1) &
2416 & **2*y(2)*y(4)**2 + 650*y(1)**2*y(3)**3 + 975*y(1)**2*y(3)**2*y(4) + 535*y(1) &
2417 & **2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 + 720*y(1)*y(2)**3*y(3) &
2418 & + 360*y(1)*y(2)**3*y(4) + 645*y(1)*y(2)**2*y(3)**2 + 645*y(1)*y(2)**2*y(3)*y(4) &
2419 & + 165*y(1)*y(2)**2*y(4)**2 + 210*y(1)*y(2)*y(3)**3 + 315*y(1)*y(2)*y(3)**2*y(4) &
2420 & + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 + 30*y(1) &
2421 & *y(3)**3*y(4) + 20*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 90*y(2)**5 &
2422 & + 300*y(2)**4*y(3) + 150*y(2)**4*y(4) + 360*y(2)**3*y(3)**2 + 360*y(2)**3*y(3) &
2423 & *y(4) + 90*y(2)**3*y(4)**2 + 180*y(2)**2*y(3)**3 + 270*y(2)**2*y(3)**2*y(4) &
2424 & + 130*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3) &
2425 & **3*y(4) + 40*y(2)*y(3)**2*y(4)**2 + 10*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2)) &
2426 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2427 & + y(4))**2)
2428 beta_coef_y(i + 1, 0, &
2429 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
2430 & **3*y(4) + 600*y(1)**2*y(2)**2 + 800*y(1)**2*y(2)*y(3) + 400*y(1)**2*y(2)*y(4) &
2431 & + 260*y(1)**2*y(3)**2 + 260*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 135*y(1) &
2432 & *y(2)**3 + 270*y(1)*y(2)**2*y(3) + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 &
2433 & + 165*y(1)*y(2)*y(3)*y(4) + 30*y(1)*y(2)*y(4)**2 + 30*y(1)*y(3)**3 + 45*y(1)*y(3) &
2434 & **2*y(4) + 15*y(1)*y(3)*y(4)**2 + 45*y(2)**4 + 120*y(2)**3*y(3) + 60*y(2)**3*y(4) &
2435 & + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3) &
2436 & **3 + 60*y(2)*y(3)**2*y(4) + 20*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) &
2437 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2438 & + y(3) + y(4))**2)
2439 end do
2440 else
2441 ! (Fu, et al., 2016) Table 2 (for right flux)
2442 d_cbl_y(0,:) = 18._wp/35._wp
2443 d_cbl_y(1,:) = 3._wp/35._wp
2444 d_cbl_y(2,:) = 9._wp/35._wp
2445 d_cbl_y(3,:) = 1._wp/35._wp
2446 d_cbl_y(4,:) = 4._wp/35._wp
2447
2448 d_cbr_y(0,:) = 18._wp/35._wp
2449 d_cbr_y(1,:) = 9._wp/35._wp
2450 d_cbr_y(2,:) = 3._wp/35._wp
2451 d_cbr_y(3,:) = 4._wp/35._wp
2452 d_cbr_y(4,:) = 1._wp/35._wp
2453 end if
2454 end if
2455 end if
2456# 192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2457 ! Computing WENO3 Coefficients
2458 if (weno_dir == 3) then
2459 if (weno_order == 3) then
2460 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2461 ! Polynomial reconstruction coefficients
2462 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
2463 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
2464
2465 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
2466 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
2467
2468 ! Ideal (linear) weights
2469 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
2470 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
2471
2472 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
2473 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
2474
2475 ! Smoothness indicator coefficients
2476 beta_coef_z(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
2477 beta_coef_z(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
2478 end do
2479
2480 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2481 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2482 if (null_weights) then
2483 if (bc_s%beg == bc_riemann_extrap) then
2484 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2485 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2486 end if
2487
2488 if (bc_s%end == bc_riemann_extrap) then
2489 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
2490 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
2491 end if
2492 end if
2493 ! END: Computing WENO3 Coefficients
2494
2495 ! Computing WENO5 Coefficients
2496 else if (weno_order == 5) then
2497 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2498 ! Polynomial reconstruction coefficients
2499 poly_coef_cbr_z(i + 1, 0, &
2500 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
2501 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2502 poly_coef_cbr_z(i + 1, 1, &
2503 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
2504 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
2505 poly_coef_cbr_z(i + 1, 1, &
2506 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
2507 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2508 poly_coef_cbr_z(i + 1, 2, &
2509 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2510 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2511 poly_coef_cbl_z(i + 1, 0, &
2512 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
2513 & *(s_cb(i + 3) - s_cb(i + 1)))
2514 poly_coef_cbl_z(i + 1, 1, &
2515 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
2516 & + 2))*(s_cb(i) - s_cb(i + 2)))
2517 poly_coef_cbl_z(i + 1, 1, &
2518 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
2519 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2520 poly_coef_cbl_z(i + 1, 2, &
2521 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
2522 & *(s_cb(i - 2) - s_cb(i + 1)))
2523
2524 poly_coef_cbr_z(i + 1, 0, &
2525 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
2526 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
2527 poly_coef_cbr_z(i + 1, 2, &
2528 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
2529 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
2530 poly_coef_cbl_z(i + 1, 0, &
2531 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
2532 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
2533 poly_coef_cbl_z(i + 1, 2, &
2534 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
2535 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
2536
2537 ! Ideal (linear) weights
2538 d_cbr_z(0, &
2539 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2540 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2541 d_cbr_z(2, &
2542 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
2543 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2544 d_cbl_z(0, &
2545 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
2546 & *(s_cb(i + 3) - s_cb(i - 1)))
2547 d_cbl_z(2, &
2548 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
2549 & *(s_cb(i - 2) - s_cb(i + 3)))
2550
2551 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2552 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2553
2554 ! Smoothness indicator coefficients
2555 beta_coef_z(i + 1, 0, &
2556 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2557 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2558 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2559
2560 beta_coef_z(i + 1, 0, &
2561 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2562 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
2563 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
2564 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
2565
2566 beta_coef_z(i + 1, 0, &
2567 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2568 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
2569 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
2570 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2571
2572 beta_coef_z(i + 1, 1, &
2573 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2574 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2575 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2576
2577 beta_coef_z(i + 1, 1, &
2578 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
2579 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
2580 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
2581 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
2582
2583 beta_coef_z(i + 1, 1, &
2584 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2585 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2586 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
2587
2588 beta_coef_z(i + 1, 2, &
2589 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2590 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
2591 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
2592 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
2593
2594 beta_coef_z(i + 1, 2, &
2595 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2596 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
2597 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
2598 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
2599
2600 beta_coef_z(i + 1, 2, &
2601 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2602 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2603 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2604 end do
2605
2606 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2607 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2608 if (null_weights) then
2609 if (bc_s%beg == bc_riemann_extrap) then
2610 d_cbr_z(1:2,0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2611 d_cbl_z(1:2,0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2612 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:,1) = d_cbr_z(:,1)/sum(d_cbr_z(:,1))
2613 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:,1) = d_cbl_z(:,1)/sum(d_cbl_z(:,1))
2614 end if
2615
2616 if (bc_s%end == bc_riemann_extrap) then
2617 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:,s - 1) = d_cbr_z(:, &
2618 & s - 1)/sum(d_cbr_z(:,s - 1))
2619 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:,s - 1) = d_cbl_z(:, &
2620 & s - 1)/sum(d_cbl_z(:,s - 1))
2621 d_cbr_z(0:1,s) = 0._wp; d_cbr_z(2, s) = 1._wp
2622 d_cbl_z(0:1,s) = 0._wp; d_cbl_z(2, s) = 1._wp
2623 end if
2624 end if
2625 else
2626 if (.not. teno) then
2627 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2628 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
2629 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
2630 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
2631 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
2632 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
2633 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2634 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
2635 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
2636 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
2637 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
2638 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2639
2640 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2641 d_cbr_z(0, &
2642 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2643 & *(w(1) - w(8)))
2644 d_cbr_z(1, &
2645 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2646 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
2647 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2648 & *(w(2) - w(8)))
2649 d_cbr_z(2, &
2650 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2651 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
2652 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2653 & *(w(3) - w(8)))
2654 d_cbr_z(3, &
2655 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2656 & *(w(3) - w(8)))
2657
2658 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
2659 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
2660 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
2661 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
2662 w(1) = s_cb(i + 4) - s_cb(i)
2663 w(2) = s_cb(i + 3) - s_cb(i)
2664 w(3) = s_cb(i + 2) - s_cb(i)
2665 w(4) = s_cb(i + 1) - s_cb(i)
2666 w(5) = s_cb(i) - s_cb(i)
2667 w(6) = s_cb(i - 1) - s_cb(i)
2668 w(7) = s_cb(i - 2) - s_cb(i)
2669 w(8) = s_cb(i - 3) - s_cb(i)
2670 d_cbl_z(0, &
2671 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2672 & *(w(3) - w(8)))
2673 d_cbl_z(1, &
2674 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2675 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
2676 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2677 & *(w(3) - w(8)))
2678 d_cbl_z(2, &
2679 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2680 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
2681 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2682 & *(w(2) - w(8)))
2683 d_cbl_z(3, &
2684 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2685 & *(w(1) - w(8)))
2686 ! Note: Left has the reversed order of both points and coefficients compared to the right
2687
2688 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2689 poly_coef_cbr_z(i + 1, 0, &
2690 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2691 & + y(2) + y(3) + y(4)))
2692 poly_coef_cbr_z(i + 1, 0, &
2693 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2694 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2695 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2696 poly_coef_cbr_z(i + 1, 0, &
2697 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2698 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2699 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2700
2701 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2702 poly_coef_cbr_z(i + 1, 1, &
2703 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2704 & + y(2) + y(3) + y(4)))
2705 poly_coef_cbr_z(i + 1, 1, &
2706 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2707 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2708 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2709 poly_coef_cbr_z(i + 1, 1, &
2710 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2711 & + y(2) + y(3) + y(4)))
2712
2713 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2714 poly_coef_cbr_z(i + 1, 2, &
2715 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2716 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2717 poly_coef_cbr_z(i + 1, 2, &
2718 & 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2719 & + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) &
2720 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2721 poly_coef_cbr_z(i + 1, 2, &
2722 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2723 & + y(2) + y(3) + y(4)))
2724
2725 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2726 poly_coef_cbr_z(i + 1, 3, &
2727 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2728 & + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) &
2729 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2730 poly_coef_cbr_z(i + 1, 3, &
2731 & 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) &
2732 & + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2)) &
2733 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2734 & + y(4)))
2735 poly_coef_cbr_z(i + 1, 3, &
2736 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2737 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2738
2739 ! Element-wise: see the no-reversed-sections note above.
2740 y(1) = s_cb(i + 1) - s_cb(i)
2741 y(2) = s_cb(i) - s_cb(i - 1)
2742 y(3) = s_cb(i - 1) - s_cb(i - 2)
2743 y(4) = s_cb(i - 2) - s_cb(i - 3)
2744 poly_coef_cbl_z(i + 1, 3, &
2745 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2746 & + y(2) + y(3) + y(4)))
2747 poly_coef_cbl_z(i + 1, 3, &
2748 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2749 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2750 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2751 poly_coef_cbl_z(i + 1, 3, &
2752 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2753 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2754 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2755
2756 ! Element-wise: see the no-reversed-sections note above.
2757 y(1) = s_cb(i + 2) - s_cb(i + 1)
2758 y(2) = s_cb(i + 1) - s_cb(i)
2759 y(3) = s_cb(i) - s_cb(i - 1)
2760 y(4) = s_cb(i - 1) - s_cb(i - 2)
2761 poly_coef_cbl_z(i + 1, 2, &
2762 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2763 & + y(2) + y(3) + y(4)))
2764 poly_coef_cbl_z(i + 1, 2, &
2765 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2766 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2767 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2768 poly_coef_cbl_z(i + 1, 2, &
2769 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2770 & + y(2) + y(3) + y(4)))
2771
2772 ! Element-wise: see the no-reversed-sections note above.
2773 y(1) = s_cb(i + 3) - s_cb(i + 2)
2774 y(2) = s_cb(i + 2) - s_cb(i + 1)
2775 y(3) = s_cb(i + 1) - s_cb(i)
2776 y(4) = s_cb(i) - s_cb(i - 1)
2777 poly_coef_cbl_z(i + 1, 1, &
2778 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2779 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2780 poly_coef_cbl_z(i + 1, 1, &
2781 & 1) = (y(3)*y(4)*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2782 & + 6*y(2)*y(3) + 2*y(4)*y(2) + 3*y(3)**2 + 2*y(4)*y(3)))/((y(2) + y(3))*(y(1) &
2783 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2784 poly_coef_cbl_z(i + 1, 1, &
2785 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2786 & + y(2) + y(3) + y(4)))
2787
2788 ! Element-wise: see the no-reversed-sections note above.
2789 y(1) = s_cb(i + 4) - s_cb(i + 3)
2790 y(2) = s_cb(i + 3) - s_cb(i + 2)
2791 y(3) = s_cb(i + 2) - s_cb(i + 1)
2792 y(4) = s_cb(i + 1) - s_cb(i)
2793 poly_coef_cbl_z(i + 1, 0, &
2794 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2795 & + 6*y(3)*y(4) + 2*y(1)*y(3) + 3*y(4)**2 + 2*y(1)*y(4)))/((y(3) + y(4))*(y(2) &
2796 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2797 poly_coef_cbl_z(i + 1, 0, &
2798 & 1) = -(y(4)*(y(3) + y(4))*(y(1)**2 + 3*y(1)*y(2) + 3*y(1)*y(3) + 2*y(1)*y(4) &
2799 & + 3*y(2)**2 + 6*y(2)*y(3) + 4*y(2)*y(4) + 3*y(3)**2 + 4*y(3)*y(4) + y(4)**2)) &
2800 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2801 & + y(4)))
2802 poly_coef_cbl_z(i + 1, 0, &
2803 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2804 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2805
2806 poly_coef_cbl_z(i + 1,:,:) = -poly_coef_cbl_z(i + 1,:,:)
2807 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2808
2809 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2810 beta_coef_z(i + 1, 3, &
2811 & 0) = (4*y(4)**2*(5*y(1)**2*y(2)**2 + 20*y(1)**2*y(2)*y(3) + 15*y(1)**2*y(2)*y(4) &
2812 & + 20*y(1)**2*y(3)**2 + 30*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 10*y(1)*y(2) &
2813 & **3 + 60*y(1)*y(2)**2*y(3) + 45*y(1)*y(2)**2*y(4) + 110*y(1)*y(2)*y(3)**2 &
2814 & + 165*y(1)*y(2)*y(3)*y(4) + 260*y(1)*y(2)*y(4)**2 + 60*y(1)*y(3)**3 + 135*y(1) &
2815 & *y(3)**2*y(4) + 400*y(1)*y(3)*y(4)**2 + 225*y(1)*y(4)**3 + 5*y(2)**4 + 40*y(2) &
2816 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2817 & + 260*y(2)**2*y(4)**2 + 120*y(2)*y(3)**3 + 270*y(2)*y(3)**2*y(4) + 800*y(2)*y(3) &
2818 & *y(4)**2 + 450*y(2)*y(4)**3 + 45*y(3)**4 + 135*y(3)**3*y(4) + 600*y(3)**2*y(4) &
2819 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2820 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2821 beta_coef_z(i + 1, 3, &
2822 & 1) = -(4*y(4)**2*(10*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2)*y(4) + 20*y(1)**3*y(3) &
2823 & **2 + 25*y(1)**3*y(3)*y(4) + 105*y(1)**3*y(4)**2 + 40*y(1)**2*y(2)**2*y(3) &
2824 & + 20*y(1)**2*y(2)**2*y(4) + 130*y(1)**2*y(2)*y(3)**2 + 155*y(1)**2*y(2)*y(3)*y(4) &
2825 & + 535*y(1)**2*y(2)*y(4)**2 + 90*y(1)**2*y(3)**3 + 165*y(1)**2*y(3)**2*y(4) &
2826 & + 790*y(1)**2*y(3)*y(4)**2 + 415*y(1)**2*y(4)**3 + 60*y(1)*y(2)**3*y(3) + 30*y(1) &
2827 & *y(2)**3*y(4) + 270*y(1)*y(2)**2*y(3)**2 + 315*y(1)*y(2)**2*y(3)*y(4) + 975*y(1) &
2828 & *y(2)**2*y(4)**2 + 360*y(1)*y(2)*y(3)**3 + 645*y(1)*y(2)*y(3)**2*y(4) + 2850*y(1) &
2829 & *y(2)*y(3)*y(4)**2 + 1460*y(1)*y(2)*y(4)**3 + 150*y(1)*y(3)**4 + 360*y(1)*y(3) &
2830 & **3*y(4) + 2000*y(1)*y(3)**2*y(4)**2 + 2005*y(1)*y(3)*y(4)**3 + 2077*y(1)*y(4) &
2831 & **4 + 30*y(2)**4*y(3) + 15*y(2)**4*y(4) + 180*y(2)**3*y(3)**2 + 210*y(2)**3*y(3) &
2832 & *y(4) + 650*y(2)**3*y(4)**2 + 360*y(2)**2*y(3)**3 + 645*y(2)**2*y(3)**2*y(4) &
2833 & + 2850*y(2)**2*y(3)*y(4)**2 + 1460*y(2)**2*y(4)**3 + 300*y(2)*y(3)**4 + 720*y(2) &
2834 & *y(3)**3*y(4) + 4000*y(2)*y(3)**2*y(4)**2 + 4010*y(2)*y(3)*y(4)**3 + 4154*y(2) &
2835 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2836 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2837 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2838 beta_coef_z(i + 1, 3, &
2839 & 2) = (4*y(4)**2*(10*y(2)**3*y(3) + 5*y(2)**3*y(4) + 50*y(2)**2*y(3)**2 + 60*y(2) &
2840 & **2*y(3)*y(4) + 10*y(1)*y(2)**2*y(3) + 215*y(2)**2*y(4)**2 + 5*y(1)*y(2)**2*y(4) &
2841 & + 70*y(2)*y(3)**3 + 130*y(2)*y(3)**2*y(4) + 30*y(1)*y(2)*y(3)**2 + 775*y(2)*y(3) &
2842 & *y(4)**2 + 35*y(1)*y(2)*y(3)*y(4) + 415*y(2)*y(4)**3 + 110*y(1)*y(2)*y(4)**2 &
2843 & + 30*y(3)**4 + 75*y(3)**3*y(4) + 20*y(1)*y(3)**3 + 665*y(3)**2*y(4)**2 + 35*y(1) &
2844 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2845 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2846 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2847 beta_coef_z(i + 1, 3, &
2848 & 3) = (4*y(4)**2*(5*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 50*y(1)**4*y(4)**2 &
2849 & + 30*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 300*y(1)**3*y(2)*y(4)**2 &
2850 & + 30*y(1)**3*y(3)**3 + 45*y(1)**3*y(3)**2*y(4) + 415*y(1)**3*y(3)*y(4)**2 &
2851 & + 200*y(1)**3*y(4)**3 + 75*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2852 & + 750*y(1)**2*y(2)**2*y(4)**2 + 150*y(1)**2*y(2)*y(3)**3 + 225*y(1)**2*y(2)*y(3) &
2853 & **2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 1000*y(1)**2*y(2)*y(4)**3 + 75*y(1) &
2854 & **2*y(3)**4 + 150*y(1)**2*y(3)**3*y(4) + 1390*y(1)**2*y(3)**2*y(4)**2 + 1315*y(1) &
2855 & **2*y(3)*y(4)**3 + 1081*y(1)**2*y(4)**4 + 90*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2) &
2856 & **3*y(3)*y(4) + 900*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2)**2*y(3)**3 + 405*y(1) &
2857 & *y(2)**2*y(3)**2*y(4) + 3735*y(1)*y(2)**2*y(3)*y(4)**2 + 1800*y(1)*y(2)**2*y(4) &
2858 & **3 + 270*y(1)*y(2)*y(3)**4 + 540*y(1)*y(2)*y(3)**3*y(4) + 5025*y(1)*y(2)*y(3) &
2859 & **2*y(4)**2 + 4755*y(1)*y(2)*y(3)*y(4)**3 + 4224*y(1)*y(2)*y(4)**4 + 90*y(1)*y(3) &
2860 & **5 + 225*y(1)*y(3)**4*y(4) + 2190*y(1)*y(3)**3*y(4)**2 + 3060*y(1)*y(3)**2*y(4) &
2861 & **3 + 4529*y(1)*y(3)*y(4)**4 + 1762*y(1)*y(4)**5 + 45*y(2)**4*y(3)**2 + 45*y(2) &
2862 & **4*y(3)*y(4) + 450*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2)**3*y(3) &
2863 & **2*y(4) + 2490*y(2)**3*y(3)*y(4)**2 + 1200*y(2)**3*y(4)**3 + 270*y(2)**2*y(3) &
2864 & **4 + 540*y(2)**2*y(3)**3*y(4) + 5025*y(2)**2*y(3)**2*y(4)**2 + 4755*y(2)**2*y(3) &
2865 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2866 & + 4380*y(2)*y(3)**3*y(4)**2 + 6120*y(2)*y(3)**2*y(4)**3 + 9058*y(2)*y(3)*y(4)**4 &
2867 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2868 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2869 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2870 & + y(3) + y(4))**2)
2871 beta_coef_z(i + 1, 3, &
2872 & 4) = -(4*y(4)**2*(10*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 100*y(1) &
2873 & **2*y(2)*y(4)**2 + 10*y(1)**2*y(3)**3 + 15*y(1)**2*y(3)**2*y(4) + 205*y(1) &
2874 & **2*y(3)*y(4)**2 + 100*y(1)**2*y(4)**3 + 30*y(1)*y(2)**2*y(3)**2 + 30*y(1)*y(2) &
2875 & **2*y(3)*y(4) + 300*y(1)*y(2)**2*y(4)**2 + 60*y(1)*y(2)*y(3)**3 + 90*y(1)*y(2) &
2876 & *y(3)**2*y(4) + 1030*y(1)*y(2)*y(3)*y(4)**2 + 500*y(1)*y(2)*y(4)**3 + 30*y(1) &
2877 & *y(3)**4 + 60*y(1)*y(3)**3*y(4) + 835*y(1)*y(3)**2*y(4)**2 + 805*y(1)*y(3)*y(4) &
2878 & **3 + 1762*y(1)*y(4)**4 + 30*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 300*y(2) &
2879 & **3*y(4)**2 + 90*y(2)**2*y(3)**3 + 135*y(2)**2*y(3)**2*y(4) + 1445*y(2)**2*y(3) &
2880 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2881 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2882 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2883 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2884 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2885 beta_coef_z(i + 1, 3, &
2886 & 5) = (4*y(4)**2*(5*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 &
2887 & + 10*y(2)*y(3)**3 + 15*y(2)*y(3)**2*y(4) + 205*y(2)*y(3)*y(4)**2 + 100*y(2)*y(4) &
2888 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2889 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2890 & + y(4))**2)
2891
2892 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2893 beta_coef_z(i + 1, 2, &
2894 & 0) = (4*y(3)**2*(5*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 &
2895 & + 10*y(1)*y(2)**3 + 15*y(1)*y(2)**2*y(3) + 205*y(1)*y(2)*y(3)**2 + 100*y(1)*y(3) &
2896 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2897 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2898 & + y(4))**2)
2899 beta_coef_z(i + 1, 2, &
2900 & 1) = (4*y(3)**2*(5*y(1)**3*y(2)*y(3) + 10*y(1)**3*y(2)*y(4) - 95*y(1)**3*y(3)**2 &
2901 & + 5*y(1)**3*y(3)*y(4) + 20*y(1)**2*y(2)**2*y(3) + 40*y(1)**2*y(2)**2*y(4) &
2902 & - 465*y(1)**2*y(2)*y(3)**2 + 55*y(1)**2*y(2)*y(3)*y(4) + 10*y(1)**2*y(2)*y(4)**2 &
2903 & - 285*y(1)**2*y(3)**3 + 20*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 &
2904 & + 30*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) - 825*y(1)*y(2)**2*y(3)**2 &
2905 & + 135*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 - 1040*y(1)*y(2)*y(3)**3 &
2906 & + 100*y(1)*y(2)*y(3)**2*y(4) + 35*y(1)*y(2)*y(3)*y(4)**2 - 1847*y(1)*y(3)**4 &
2907 & + 125*y(1)*y(3)**3*y(4) + 110*y(1)*y(3)**2*y(4)**2 + 15*y(2)**4*y(3) + 30*y(2) &
2908 & **4*y(4) - 550*y(2)**3*y(3)**2 + 90*y(2)**3*y(3)*y(4) + 20*y(2)**3*y(4)**2 &
2909 & - 1040*y(2)**2*y(3)**3 + 100*y(2)**2*y(3)**2*y(4) + 35*y(2)**2*y(3)*y(4)**2 &
2910 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2911 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2912 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2913 & **2)
2914 beta_coef_z(i + 1, 2, &
2915 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2916 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2917 & + 5*y(1)*y(2)**2*y(3) + 10*y(1)*y(2)**2*y(4) + 100*y(1)*y(3)**2*y(4) + 205*y(2) &
2918 & *y(3)**2*y(4) + 15*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2919 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2920 & + y(4))**2)
2921 beta_coef_z(i + 1, 2, &
2922 & 3) = (4*y(3)**2*(50*y(1)**4*y(3)**2 + 5*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 &
2923 & + 300*y(1)**3*y(2)*y(3)**2 + 30*y(1)**3*y(2)*y(3)*y(4) + 30*y(1)**3*y(2)*y(4)**2 &
2924 & + 200*y(1)**3*y(3)**3 + 25*y(1)**3*y(3)**2*y(4) + 35*y(1)**3*y(3)*y(4)**2 &
2925 & + 10*y(1)**3*y(4)**3 + 750*y(1)**2*y(2)**2*y(3)**2 + 75*y(1)**2*y(2)**2*y(3)*y(4) &
2926 & + 75*y(1)**2*y(2)**2*y(4)**2 + 1000*y(1)**2*y(2)*y(3)**3 + 125*y(1)**2*y(2)*y(3) &
2927 & **2*y(4) + 175*y(1)**2*y(2)*y(3)*y(4)**2 + 50*y(1)**2*y(2)*y(4)**3 + 1081*y(1) &
2928 & **2*y(3)**4 - 50*y(1)**2*y(3)**3*y(4) - 10*y(1)**2*y(3)**2*y(4)**2 + 45*y(1) &
2929 & **2*y(3)*y(4)**3 + 5*y(1)**2*y(4)**4 + 900*y(1)*y(2)**3*y(3)**2 + 90*y(1)*y(2) &
2930 & **3*y(3)*y(4) + 90*y(1)*y(2)**3*y(4)**2 + 1800*y(1)*y(2)**2*y(3)**3 + 225*y(1) &
2931 & *y(2)**2*y(3)**2*y(4) + 315*y(1)*y(2)**2*y(3)*y(4)**2 + 90*y(1)*y(2)**2*y(4)**3 &
2932 & + 4224*y(1)*y(2)*y(3)**4 - 120*y(1)*y(2)*y(3)**3*y(4) + 25*y(1)*y(2)*y(3)**2*y(4) &
2933 & **2 + 165*y(1)*y(2)*y(3)*y(4)**3 + 20*y(1)*y(2)*y(4)**4 + 3324*y(1)*y(3)**5 &
2934 & + 1407*y(1)*y(3)**4*y(4) - 100*y(1)*y(3)**3*y(4)**2 + 70*y(1)*y(3)**2*y(4)**3 &
2935 & + 15*y(1)*y(3)*y(4)**4 + 450*y(2)**4*y(3)**2 + 45*y(2)**4*y(3)*y(4) + 45*y(2) &
2936 & **4*y(4)**2 + 1200*y(2)**3*y(3)**3 + 150*y(2)**3*y(3)**2*y(4) + 210*y(2)**3*y(3) &
2937 & *y(4)**2 + 60*y(2)**3*y(4)**3 + 4224*y(2)**2*y(3)**4 - 120*y(2)**2*y(3)**3*y(4) &
2938 & + 25*y(2)**2*y(3)**2*y(4)**2 + 165*y(2)**2*y(3)*y(4)**3 + 20*y(2)**2*y(4)**4 &
2939 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2940 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2941 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2942 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2943 & + y(3) + y(4))**2)
2944 beta_coef_z(i + 1, 2, &
2945 & 4) = -(4*y(3)**2*(100*y(1)**2*y(2)*y(3)**2 + 10*y(1)**2*y(2)*y(3)*y(4) + 10*y(1) &
2946 & **2*y(2)*y(4)**2 - 95*y(1)**2*y(3)**2*y(4) + 5*y(1)**2*y(3)*y(4)**2 + 300*y(1) &
2947 & *y(2)**2*y(3)**2 + 30*y(1)*y(2)**2*y(3)*y(4) + 30*y(1)*y(2)**2*y(4)**2 + 200*y(1) &
2948 & *y(2)*y(3)**3 - 260*y(1)*y(2)*y(3)**2*y(4) + 50*y(1)*y(2)*y(3)*y(4)**2 + 10*y(1) &
2949 & *y(2)*y(4)**3 + 1562*y(1)*y(3)**4 - 190*y(1)*y(3)**3*y(4) + 15*y(1)*y(3)**2*y(4) &
2950 & **2 + 5*y(1)*y(3)*y(4)**3 + 300*y(2)**3*y(3)**2 + 30*y(2)**3*y(3)*y(4) + 30*y(2) &
2951 & **3*y(4)**2 + 400*y(2)**2*y(3)**3 - 235*y(2)**2*y(3)**2*y(4) + 85*y(2)**2*y(3) &
2952 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2953 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2954 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2955 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2956 & **2)
2957 beta_coef_z(i + 1, 2, &
2958 & 5) = (4*y(3)**2*(50*y(2)**2*y(3)**2 + 5*y(2)**2*y(3)*y(4) + 5*y(2)**2*y(4)**2 &
2959 & - 95*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 781*y(3)**4 + 50*y(3)**2*y(4)**2)) &
2960 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2961
2962 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2963 beta_coef_z(i + 1, 1, &
2964 & 0) = (4*y(2)**2*(50*y(1)**2*y(2)**2 + 5*y(1)**2*y(2)*y(3) + 5*y(1)**2*y(3)**2 &
2965 & - 95*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 781*y(2)**4 + 50*y(2)**2*y(3)**2)) &
2966 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2967 beta_coef_z(i + 1, 1, &
2968 & 1) = -(4*y(2)**2*(105*y(1)**3*y(2)**2 + 25*y(1)**3*y(2)*y(3) + 5*y(1)**3*y(2) &
2969 & *y(4) + 20*y(1)**3*y(3)**2 + 10*y(1)**3*y(3)*y(4) + 110*y(1)**2*y(2)**3 - 35*y(1) &
2970 & **2*y(2)**2*y(3) + 15*y(1)**2*y(2)**2*y(4) + 85*y(1)**2*y(2)*y(3)**2 + 50*y(1) &
2971 & **2*y(2)*y(3)*y(4) + 5*y(1)**2*y(2)*y(4)**2 + 30*y(1)**2*y(3)**3 + 30*y(1) &
2972 & **2*y(3)**2*y(4) + 10*y(1)**2*y(3)*y(4)**2 + 1467*y(1)*y(2)**4 - 460*y(1)*y(2) &
2973 & **3*y(3) - 190*y(1)*y(2)**3*y(4) - 235*y(1)*y(2)**2*y(3)**2 - 260*y(1)*y(2) &
2974 & **2*y(3)*y(4) - 95*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2)*y(3)**3 + 30*y(1)*y(2) &
2975 & *y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 3124*y(2)**5 + 3224*y(2)**4*y(3) &
2976 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2977 & **2*y(3)**3 + 300*y(2)**2*y(3)**2*y(4) + 100*y(2)**2*y(3)*y(4)**2))/(5*(y(2) &
2978 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2979 & + y(3) + y(4))**2)
2980 beta_coef_z(i + 1, 1, &
2981 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2982 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2983 & + 205*y(1)*y(2)**2*y(3) + 100*y(1)*y(2)**2*y(4) + 10*y(1)*y(3)**2*y(4) + 5*y(2) &
2984 & *y(3)**2*y(4) - 95*y(2)**2*y(3)*y(4) + 10*y(1)*y(2)*y(3)*y(4)))/(5*(y(1) + y(2)) &
2985 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2986 & + y(4))**2)
2987 beta_coef_z(i + 1, 1, &
2988 & 3) = (4*y(2)**2*(60*y(1)**4*y(2)**2 + 30*y(1)**4*y(2)*y(3) + 15*y(1)**4*y(2)*y(4) &
2989 & + 20*y(1)**4*y(3)**2 + 20*y(1)**4*y(3)*y(4) + 5*y(1)**4*y(4)**2 + 135*y(1) &
2990 & **3*y(2)**3 + 140*y(1)**3*y(2)**2*y(3) + 70*y(1)**3*y(2)**2*y(4) + 165*y(1) &
2991 & **3*y(2)*y(3)**2 + 165*y(1)**3*y(2)*y(3)*y(4) + 45*y(1)**3*y(2)*y(4)**2 + 60*y(1) &
2992 & **3*y(3)**3 + 90*y(1)**3*y(3)**2*y(4) + 50*y(1)**3*y(3)*y(4)**2 + 10*y(1)**3*y(4) &
2993 & **3 + 771*y(1)**2*y(2)**4 - 200*y(1)**2*y(2)**3*y(3) - 100*y(1)**2*y(2)**3*y(4) &
2994 & + 25*y(1)**2*y(2)**2*y(3)**2 + 25*y(1)**2*y(2)**2*y(3)*y(4) - 10*y(1)**2*y(2) &
2995 & **2*y(4)**2 + 210*y(1)**2*y(2)*y(3)**3 + 315*y(1)**2*y(2)*y(3)**2*y(4) + 175*y(1) &
2996 & **2*y(2)*y(3)*y(4)**2 + 35*y(1)**2*y(2)*y(4)**3 + 45*y(1)**2*y(3)**4 + 90*y(1) &
2997 & **2*y(3)**3*y(4) + 75*y(1)**2*y(3)**2*y(4)**2 + 30*y(1)**2*y(3)*y(4)**3 + 5*y(1) &
2998 & **2*y(4)**4 + 3039*y(1)*y(2)**5 + 2814*y(1)*y(2)**4*y(3) + 1407*y(1)*y(2)**4*y(4) &
2999 & - 120*y(1)*y(2)**3*y(3)**2 - 120*y(1)*y(2)**3*y(3)*y(4) - 50*y(1)*y(2)**3*y(4) &
3000 & **2 + 150*y(1)*y(2)**2*y(3)**3 + 225*y(1)*y(2)**2*y(3)**2*y(4) + 125*y(1)*y(2) &
3001 & **2*y(3)*y(4)**2 + 25*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2) &
3002 & *y(3)**3*y(4) + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1) &
3003 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
3004 & **4*y(3)**2 + 4224*y(2)**4*y(3)*y(4) + 1081*y(2)**4*y(4)**2 + 1200*y(2)**3*y(3) &
3005 & **3 + 1800*y(2)**3*y(3)**2*y(4) + 1000*y(2)**3*y(3)*y(4)**2 + 200*y(2)**3*y(4) &
3006 & **3 + 450*y(2)**2*y(3)**4 + 900*y(2)**2*y(3)**3*y(4) + 750*y(2)**2*y(3)**2*y(4) &
3007 & **2 + 300*y(2)**2*y(3)*y(4)**3 + 50*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) &
3008 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3009 beta_coef_z(i + 1, 1, &
3010 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
3011 & **2*y(2)**2*y(4) + 35*y(1)**2*y(2)*y(3)**2 + 35*y(1)**2*y(2)*y(3)*y(4) + 5*y(1) &
3012 & **2*y(2)*y(4)**2 + 20*y(1)**2*y(3)**3 + 30*y(1)**2*y(3)**2*y(4) + 10*y(1)**2*y(3) &
3013 & *y(4)**2 - 1452*y(1)*y(2)**4 + 250*y(1)*y(2)**3*y(3) + 125*y(1)*y(2)**3*y(4) &
3014 & + 100*y(1)*y(2)**2*y(3)**2 + 100*y(1)*y(2)**2*y(3)*y(4) + 20*y(1)*y(2)**2*y(4) &
3015 & **2 + 90*y(1)*y(2)*y(3)**3 + 135*y(1)*y(2)*y(3)**2*y(4) + 55*y(1)*y(2)*y(3)*y(4) &
3016 & **2 + 5*y(1)*y(2)*y(4)**3 + 30*y(1)*y(3)**4 + 60*y(1)*y(3)**3*y(4) + 40*y(1)*y(3) &
3017 & **2*y(4)**2 + 10*y(1)*y(3)*y(4)**3 - 3219*y(2)**5 - 3694*y(2)**4*y(3) - 1847*y(2) &
3018 & **4*y(4) - 1040*y(2)**3*y(3)**2 - 1040*y(2)**3*y(3)*y(4) - 285*y(2)**3*y(4)**2 &
3019 & - 550*y(2)**2*y(3)**3 - 825*y(2)**2*y(3)**2*y(4) - 465*y(2)**2*y(3)*y(4)**2 &
3020 & - 95*y(2)**2*y(4)**3 + 15*y(2)*y(3)**4 + 30*y(2)*y(3)**3*y(4) + 20*y(2)*y(3) &
3021 & **2*y(4)**2 + 5*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
3022 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3023 beta_coef_z(i + 1, 1, &
3024 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
3025 & **2*y(3)**2 + 205*y(2)**2*y(3)*y(4) + 50*y(2)**2*y(4)**2 + 10*y(2)*y(3)**3 &
3026 & + 15*y(2)*y(3)**2*y(4) + 5*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) &
3027 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3028 & + y(3) + y(4))**2)
3029
3030 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
3031 beta_coef_z(i + 1, 0, &
3032 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
3033 & **2*y(2)**2 + 205*y(1)**2*y(2)*y(3) + 50*y(1)**2*y(3)**2 + 10*y(1)*y(2)**3 &
3034 & + 15*y(1)*y(2)**2*y(3) + 5*y(1)*y(2)*y(3)**2 + 5*y(2)**4 + 10*y(2)**3*y(3) &
3035 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
3036 & + y(3) + y(4))**2)
3037 beta_coef_z(i + 1, 0, &
3038 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
3039 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
3040 & **3*y(2)*y(4) + 700*y(1)**3*y(3)**2 + 500*y(1)**3*y(3)*y(4) + 100*y(1)**3*y(4) &
3041 & **2 + 1060*y(1)**2*y(2)**3 + 2205*y(1)**2*y(2)**2*y(3) + 835*y(1)**2*y(2)**2*y(4) &
3042 & + 1445*y(1)**2*y(2)*y(3)**2 + 1030*y(1)**2*y(2)*y(3)*y(4) + 205*y(1)**2*y(2)*y(4) &
3043 & **2 + 300*y(1)**2*y(3)**3 + 300*y(1)**2*y(3)**2*y(4) + 100*y(1)**2*y(3)*y(4)**2 &
3044 & + 75*y(1)*y(2)**4 + 180*y(1)*y(2)**3*y(3) + 60*y(1)*y(2)**3*y(4) + 135*y(1)*y(2) &
3045 & **2*y(3)**2 + 90*y(1)*y(2)**2*y(3)*y(4) + 15*y(1)*y(2)**2*y(4)**2 + 30*y(1)*y(2) &
3046 & *y(3)**3 + 30*y(1)*y(2)*y(3)**2*y(4) + 10*y(1)*y(2)*y(3)*y(4)**2 + 30*y(2)**5 &
3047 & + 90*y(2)**4*y(3) + 30*y(2)**4*y(4) + 90*y(2)**3*y(3)**2 + 60*y(2)**3*y(3)*y(4) &
3048 & + 10*y(2)**3*y(4)**2 + 30*y(2)**2*y(3)**3 + 30*y(2)**2*y(3)**2*y(4) + 10*y(2) &
3049 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
3050 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3051 beta_coef_z(i + 1, 0, &
3052 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
3053 & *y(1)**3 + 665*y(1)**2*y(2)**2 + 775*y(1)**2*y(2)*y(3) + 220*y(4)*y(1)**2*y(2) &
3054 & + 215*y(1)**2*y(3)**2 + 110*y(4)*y(1)**2*y(3) + 75*y(1)*y(2)**3 + 130*y(1)*y(2) &
3055 & **2*y(3) + 35*y(4)*y(1)*y(2)**2 + 60*y(1)*y(2)*y(3)**2 + 35*y(4)*y(1)*y(2)*y(3) &
3056 & + 5*y(1)*y(3)**3 + 5*y(4)*y(1)*y(3)**2 + 30*y(2)**4 + 70*y(2)**3*y(3) + 20*y(4) &
3057 & *y(2)**3 + 50*y(2)**2*y(3)**2 + 30*y(4)*y(2)**2*y(3) + 10*y(2)*y(3)**3 + 10*y(4) &
3058 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
3059 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3060 beta_coef_z(i + 1, 0, &
3061 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
3062 & **5*y(4) + 4884*y(1)**4*y(2)**2 + 9058*y(1)**4*y(2)*y(3) + 4529*y(1)**4*y(2)*y(4) &
3063 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
3064 & + 2565*y(1)**3*y(2)**3 + 6120*y(1)**3*y(2)**2*y(3) + 3060*y(1)**3*y(2)**2*y(4) &
3065 & + 4755*y(1)**3*y(2)*y(3)**2 + 4755*y(1)**3*y(2)*y(3)*y(4) + 1315*y(1)**3*y(2) &
3066 & *y(4)**2 + 1200*y(1)**3*y(3)**3 + 1800*y(1)**3*y(3)**2*y(4) + 1000*y(1)**3*y(3) &
3067 & *y(4)**2 + 200*y(1)**3*y(4)**3 + 1395*y(1)**2*y(2)**4 + 4380*y(1)**2*y(2)**3*y(3) &
3068 & + 2190*y(1)**2*y(2)**3*y(4) + 5025*y(1)**2*y(2)**2*y(3)**2 + 5025*y(1)**2*y(2) &
3069 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
3070 & + 3735*y(1)**2*y(2)*y(3)**2*y(4) + 2075*y(1)**2*y(2)*y(3)*y(4)**2 + 415*y(1) &
3071 & **2*y(2)*y(4)**3 + 450*y(1)**2*y(3)**4 + 900*y(1)**2*y(3)**3*y(4) + 750*y(1) &
3072 & **2*y(3)**2*y(4)**2 + 300*y(1)**2*y(3)*y(4)**3 + 50*y(1)**2*y(4)**4 + 135*y(1) &
3073 & *y(2)**5 + 450*y(1)*y(2)**4*y(3) + 225*y(1)*y(2)**4*y(4) + 540*y(1)*y(2)**3*y(3) &
3074 & **2 + 540*y(1)*y(2)**3*y(3)*y(4) + 150*y(1)*y(2)**3*y(4)**2 + 270*y(1)*y(2) &
3075 & **2*y(3)**3 + 405*y(1)*y(2)**2*y(3)**2*y(4) + 225*y(1)*y(2)**2*y(3)*y(4)**2 &
3076 & + 45*y(1)*y(2)**2*y(4)**3 + 45*y(1)*y(2)*y(3)**4 + 90*y(1)*y(2)*y(3)**3*y(4) &
3077 & + 75*y(1)*y(2)*y(3)**2*y(4)**2 + 30*y(1)*y(2)*y(3)*y(4)**3 + 5*y(1)*y(2)*y(4)**4 &
3078 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
3079 & + 270*y(2)**4*y(3)*y(4) + 75*y(2)**4*y(4)**2 + 180*y(2)**3*y(3)**3 + 270*y(2) &
3080 & **3*y(3)**2*y(4) + 150*y(2)**3*y(3)*y(4)**2 + 30*y(2)**3*y(4)**3 + 45*y(2) &
3081 & **2*y(3)**4 + 90*y(2)**2*y(3)**3*y(4) + 75*y(2)**2*y(3)**2*y(4)**2 + 30*y(2) &
3082 & **2*y(3)*y(4)**3 + 5*y(2)**2*y(4)**4))/(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3)) &
3083 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3084 beta_coef_z(i + 1, 0, &
3085 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
3086 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
3087 & **3*y(2)*y(4) + 1460*y(1)**3*y(3)**2 + 1460*y(1)**3*y(3)*y(4) + 415*y(1)**3*y(4) &
3088 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
3089 & **2*y(4) + 2850*y(1)**2*y(2)*y(3)**2 + 2850*y(1)**2*y(2)*y(3)*y(4) + 790*y(1) &
3090 & **2*y(2)*y(4)**2 + 650*y(1)**2*y(3)**3 + 975*y(1)**2*y(3)**2*y(4) + 535*y(1) &
3091 & **2*y(3)*y(4)**2 + 105*y(1)**2*y(4)**3 + 270*y(1)*y(2)**4 + 720*y(1)*y(2)**3*y(3) &
3092 & + 360*y(1)*y(2)**3*y(4) + 645*y(1)*y(2)**2*y(3)**2 + 645*y(1)*y(2)**2*y(3)*y(4) &
3093 & + 165*y(1)*y(2)**2*y(4)**2 + 210*y(1)*y(2)*y(3)**3 + 315*y(1)*y(2)*y(3)**2*y(4) &
3094 & + 155*y(1)*y(2)*y(3)*y(4)**2 + 25*y(1)*y(2)*y(4)**3 + 15*y(1)*y(3)**4 + 30*y(1) &
3095 & *y(3)**3*y(4) + 20*y(1)*y(3)**2*y(4)**2 + 5*y(1)*y(3)*y(4)**3 + 90*y(2)**5 &
3096 & + 300*y(2)**4*y(3) + 150*y(2)**4*y(4) + 360*y(2)**3*y(3)**2 + 360*y(2)**3*y(3) &
3097 & *y(4) + 90*y(2)**3*y(4)**2 + 180*y(2)**2*y(3)**3 + 270*y(2)**2*y(3)**2*y(4) &
3098 & + 130*y(2)**2*y(3)*y(4)**2 + 20*y(2)**2*y(4)**3 + 30*y(2)*y(3)**4 + 60*y(2)*y(3) &
3099 & **3*y(4) + 40*y(2)*y(3)**2*y(4)**2 + 10*y(2)*y(3)*y(4)**3))/(5*(y(1) + y(2)) &
3100 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
3101 & + y(4))**2)
3102 beta_coef_z(i + 1, 0, &
3103 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
3104 & **3*y(4) + 600*y(1)**2*y(2)**2 + 800*y(1)**2*y(2)*y(3) + 400*y(1)**2*y(2)*y(4) &
3105 & + 260*y(1)**2*y(3)**2 + 260*y(1)**2*y(3)*y(4) + 60*y(1)**2*y(4)**2 + 135*y(1) &
3106 & *y(2)**3 + 270*y(1)*y(2)**2*y(3) + 135*y(1)*y(2)**2*y(4) + 165*y(1)*y(2)*y(3)**2 &
3107 & + 165*y(1)*y(2)*y(3)*y(4) + 30*y(1)*y(2)*y(4)**2 + 30*y(1)*y(3)**3 + 45*y(1)*y(3) &
3108 & **2*y(4) + 15*y(1)*y(3)*y(4)**2 + 45*y(2)**4 + 120*y(2)**3*y(3) + 60*y(2)**3*y(4) &
3109 & + 110*y(2)**2*y(3)**2 + 110*y(2)**2*y(3)*y(4) + 20*y(2)**2*y(4)**2 + 40*y(2)*y(3) &
3110 & **3 + 60*y(2)*y(3)**2*y(4) + 20*y(2)*y(3)*y(4)**2 + 5*y(3)**4 + 10*y(3)**3*y(4) &
3111 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3112 & + y(3) + y(4))**2)
3113 end do
3114 else
3115 ! (Fu, et al., 2016) Table 2 (for right flux)
3116 d_cbl_z(0,:) = 18._wp/35._wp
3117 d_cbl_z(1,:) = 3._wp/35._wp
3118 d_cbl_z(2,:) = 9._wp/35._wp
3119 d_cbl_z(3,:) = 1._wp/35._wp
3120 d_cbl_z(4,:) = 4._wp/35._wp
3121
3122 d_cbr_z(0,:) = 18._wp/35._wp
3123 d_cbr_z(1,:) = 9._wp/35._wp
3124 d_cbr_z(2,:) = 3._wp/35._wp
3125 d_cbr_z(3,:) = 4._wp/35._wp
3126 d_cbr_z(4,:) = 1._wp/35._wp
3127 end if
3128 end if
3129 end if
3130# 866 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3131
3132 ! Detect whether grid spacing is uniform (enables cancellation-free sum-of-squares beta). Tolerance uses sqrt(epsilon) so it
3133 ! works in both double and single precision: ~1.5e-8 relative in double, ~3.5e-4 in single - above FP noise, below real
3134 ! stretching.
3135 uniform_grid(weno_dir) = .true.
3136 h0 = (s_cb(s) - s_cb(0))/real(s, wp)
3137 do i = 0, s - 1
3138 if (abs((s_cb(i + 1) - s_cb(i)) - h0) > sqrt(epsilon(h0))*abs(h0)) then
3139 uniform_grid(weno_dir) = .false.
3140 exit
3141 end if
3142 end do
3143
3144 if (weno_dir == 1) then
3145
3146# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3147#if defined(MFC_OpenACC)
3148# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3149!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3150# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3151#elif defined(MFC_OpenMP)
3152# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3153!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3154# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3155#endif
3156 else if (weno_dir == 2) then
3157
3158# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3159#if defined(MFC_OpenACC)
3160# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3161!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3162# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3163#elif defined(MFC_OpenMP)
3164# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3165!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3166# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3167#endif
3168 else
3169
3170# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3171#if defined(MFC_OpenACC)
3172# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3173!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3174# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3175#elif defined(MFC_OpenMP)
3176# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3177!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3178# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3179#endif
3180 end if
3181
3182 ! Nullifying WENO coefficients and cell-boundary locations pointers
3183
3184 nullify (s_cb)
3185
3186 end subroutine s_compute_weno_coefficients
3187
3188 subroutine s_pack_weno_input_arr(v_vf)
3189
3190 type(scalar_field), dimension(1:), intent(in) :: v_vf
3191 integer :: i, j, k, l, n_vars
3192
3193
3194# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3195
3196# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3197#if defined(MFC_OpenACC)
3198# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199!$acc parallel loop collapse(4) gang vector default(present)
3200# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201#elif defined(MFC_OpenMP)
3202# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203
3204# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3205
3206# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3207
3208# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3209!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3210# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3211#endif
3212 do i = 1, v_size
3213 do l = idwbuff(3)%beg, idwbuff(3)%end
3214 do k = idwbuff(2)%beg, idwbuff(2)%end
3215 do j = idwbuff(1)%beg, idwbuff(1)%end
3216 v_rs_weno(j, k, l, i) = v_vf(i)%sf(j, k, l)
3217 end do
3218 end do
3219 end do
3220 end do
3221
3222# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3223#if defined(MFC_OpenACC)
3224# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3225!$acc end parallel loop
3226# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3227#elif defined(MFC_OpenMP)
3228# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3229
3230# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3231!$omp end target teams loop
3232# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3233#endif
3234
3235 end subroutine s_pack_weno_input_arr
3236
3237 !> Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables
3238 subroutine s_weno(v_vf, vL_rs_vf_x, vR_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
3239
3240 type(scalar_field), dimension(1:), intent(in) :: v_vf
3241 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x
3242 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vr_rs_vf_x
3243 integer, intent(in) :: weno_dir
3244 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
3245
3246# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3247 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
3248 real(wp), dimension(0:weno_num_stencils) :: poly
3249 real(wp), dimension(0:weno_num_stencils) :: alpha
3250 real(wp), dimension(0:weno_num_stencils) :: omega
3251 real(wp), dimension(0:weno_num_stencils) :: beta
3252 real(wp), dimension(0:weno_num_stencils) :: delta
3253# 936 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3254 real(wp), dimension(-3:3) :: v !< temporary field value array for clarity (WENO7 only)
3255 real(wp) :: tau
3256 integer :: i, j, k, l, q
3257 real(wp) :: vp0, vp1, vp2, vp3, vm1, vm2, vm3
3258
3259 is1_weno = is1_weno_d
3260 is2_weno = is2_weno_d
3261 is3_weno = is3_weno_d
3262
3263
3264# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3265#if defined(MFC_OpenACC)
3266# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3267!$acc update device(is1_weno, is2_weno, is3_weno)
3268# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3269#elif defined(MFC_OpenMP)
3270# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3271!$omp target update to(is1_weno, is2_weno, is3_weno)
3272# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3273#endif
3274
3275 v_size = ubound(v_vf, 1)
3276
3277# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3278#if defined(MFC_OpenACC)
3279# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3280!$acc update device(v_size)
3281# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3282#elif defined(MFC_OpenMP)
3283# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3284!$omp target update to(v_size)
3285# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3286#endif
3287
3288 if (weno_order == 1) then
3289 if (weno_dir == 1) then
3290
3291# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3292
3293# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3294#if defined(MFC_OpenACC)
3295# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3296!$acc parallel loop collapse(4) gang vector default(present)
3297# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3298#elif defined(MFC_OpenMP)
3299# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3300
3301# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3302
3303# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3304
3305# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3306!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3307# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3308#endif
3309 do i = 1, v_size
3310 do l = is3_weno%beg, is3_weno%end
3311 do k = is2_weno%beg, is2_weno%end
3312 do j = is1_weno%beg, is1_weno%end
3313 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3314 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3315 end do
3316 end do
3317 end do
3318 end do
3319
3320# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3321#if defined(MFC_OpenACC)
3322# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3323!$acc end parallel loop
3324# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3325#elif defined(MFC_OpenMP)
3326# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3327
3328# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3329!$omp end target teams loop
3330# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3331#endif
3332 else if (weno_dir == 2) then
3333
3334# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3335
3336# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3337#if defined(MFC_OpenACC)
3338# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3339!$acc parallel loop collapse(4) gang vector default(present)
3340# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3341#elif defined(MFC_OpenMP)
3342# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3343
3344# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3345
3346# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3347
3348# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3349!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3350# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3351#endif
3352 do i = 1, v_size
3353 do l = is3_weno%beg, is3_weno%end
3354 do j = is1_weno%beg, is1_weno%end
3355 do k = is2_weno%beg, is2_weno%end
3356 vl_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3357 vr_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3358 end do
3359 end do
3360 end do
3361 end do
3362
3363# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3364#if defined(MFC_OpenACC)
3365# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3366!$acc end parallel loop
3367# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3368#elif defined(MFC_OpenMP)
3369# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3370
3371# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3372!$omp end target teams loop
3373# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3374#endif
3375 else if (weno_dir == 3) then
3376
3377# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3378
3379# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3380#if defined(MFC_OpenACC)
3381# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3382!$acc parallel loop collapse(4) gang vector default(present)
3383# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3384#elif defined(MFC_OpenMP)
3385# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3386
3387# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3388
3389# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3390
3391# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3392!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3393# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3394#endif
3395 do i = 1, v_size
3396 do j = is1_weno%beg, is1_weno%end
3397 do k = is2_weno%beg, is2_weno%end
3398 do l = is3_weno%beg, is3_weno%end
3399 vl_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3400 vr_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3401 end do
3402 end do
3403 end do
3404 end do
3405
3406# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3407#if defined(MFC_OpenACC)
3408# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3409!$acc end parallel loop
3410# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3411#elif defined(MFC_OpenMP)
3412# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3413
3414# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3415!$omp end target teams loop
3416# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3417#endif
3418 end if
3419 end if
3420
3421 if (weno_order /= 1) then
3422 call s_pack_weno_input_arr(v_vf)
3423 end if
3424
3425 if (weno_order == 3) then
3426# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3427# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3428# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3429 if (weno_dir == 1) then
3430
3431# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3432
3433# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3434#if defined(MFC_OpenACC)
3435# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3436!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3437# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3438#elif defined(MFC_OpenMP)
3439# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3440
3441# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3442
3443# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3444
3445# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3446!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3447# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3448!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3449# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3450#endif
3451 do l = is3_weno%beg, is3_weno%end
3452 do k = is2_weno%beg, is2_weno%end
3453 do j = is1_weno%beg, is1_weno%end
3454 do i = 1, v_size
3455 ! reconstruct from left side
3456
3457 alpha(:) = 0._wp
3458
3459 vp0 = v_rs_weno(j, k, l, i)
3460 vm1 = v_rs_weno(j - 1, k, l, i)
3461 vp1 = v_rs_weno(j + 1, k, l, i)
3462
3463 dvd(0) = vp1 - vp0
3464 dvd(-1) = vp0 - vm1
3465
3466 poly(0) = vp0 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
3467 poly(1) = vp0 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
3468
3469 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3470 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3471
3472 if (wenojs) then
3473 do q = 0, weno_num_stencils
3474 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3475 end do
3476 else if (mapped_weno) then
3477 do q = 0, weno_num_stencils
3478 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3479 end do
3480 omega = alpha/sum(alpha)
3481 do q = 0, weno_num_stencils
3482 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3483 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3484 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3485 end do
3486 else if (wenoz) then
3487 ! Borges, et al. (2008)
3488 tau = abs(beta(1) - beta(0))
3489 do q = 0, weno_num_stencils
3490 alpha(q) = d_cbl_x(q, j)*(1._wp + tau/beta(q))
3491 end do
3492 end if
3493 omega = alpha/sum(alpha)
3494
3495 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3496
3497 ! reconstruct from right side
3498
3499 poly(0) = vp0 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3500 poly(1) = vp0 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3501
3502 if (wenojs) then
3503 do q = 0, weno_num_stencils
3504 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3505 end do
3506 else if (mapped_weno) then
3507 do q = 0, weno_num_stencils
3508 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3509 end do
3510 omega = alpha/sum(alpha)
3511 do q = 0, weno_num_stencils
3512 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3513 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3514 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3515 end do
3516 else if (wenoz) then
3517 do q = 0, weno_num_stencils
3518 alpha(q) = d_cbr_x(q, j)*(1._wp + tau/beta(q))
3519 end do
3520 end if
3521 omega = alpha/sum(alpha)
3522
3523 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3524 end do
3525 end do
3526 end do
3527 end do
3528
3529# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3530#if defined(MFC_OpenACC)
3531# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3532!$acc end parallel loop
3533# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3534#elif defined(MFC_OpenMP)
3535# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3536
3537# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3538!$omp end target teams loop
3539# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3540#endif
3541 end if
3542# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3543# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3544# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3545 if (weno_dir == 2) then
3546
3547# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3548
3549# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3550#if defined(MFC_OpenACC)
3551# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3552!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3553# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3554#elif defined(MFC_OpenMP)
3555# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3556
3557# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3558
3559# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3560
3561# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3562!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3563# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3564!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3565# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3566#endif
3567 do l = is3_weno%beg, is3_weno%end
3568 do k = is1_weno%beg, is1_weno%end
3569 do j = is2_weno%beg, is2_weno%end
3570 do i = 1, v_size
3571 ! reconstruct from left side
3572
3573 alpha(:) = 0._wp
3574
3575 vp0 = v_rs_weno(j, k, l, i)
3576 vm1 = v_rs_weno(j, k - 1, l, i)
3577 vp1 = v_rs_weno(j, k + 1, l, i)
3578
3579 dvd(0) = vp1 - vp0
3580 dvd(-1) = vp0 - vm1
3581
3582 poly(0) = vp0 + poly_coef_cbl_y(k, 0, 0)*dvd(0)
3583 poly(1) = vp0 + poly_coef_cbl_y(k, 1, 0)*dvd(-1)
3584
3585 beta(0) = beta_coef_y(k, 0, 0)*dvd(0)*dvd(0) + weno_eps
3586 beta(1) = beta_coef_y(k, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3587
3588 if (wenojs) then
3589 do q = 0, weno_num_stencils
3590 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3591 end do
3592 else if (mapped_weno) then
3593 do q = 0, weno_num_stencils
3594 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3595 end do
3596 omega = alpha/sum(alpha)
3597 do q = 0, weno_num_stencils
3598 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
3599 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3600 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
3601 end do
3602 else if (wenoz) then
3603 ! Borges, et al. (2008)
3604 tau = abs(beta(1) - beta(0))
3605 do q = 0, weno_num_stencils
3606 alpha(q) = d_cbl_y(q, k)*(1._wp + tau/beta(q))
3607 end do
3608 end if
3609 omega = alpha/sum(alpha)
3610
3611 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3612
3613 ! reconstruct from right side
3614
3615 poly(0) = vp0 + poly_coef_cbr_y(k, 0, 0)*dvd(0)
3616 poly(1) = vp0 + poly_coef_cbr_y(k, 1, 0)*dvd(-1)
3617
3618 if (wenojs) then
3619 do q = 0, weno_num_stencils
3620 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3621 end do
3622 else if (mapped_weno) then
3623 do q = 0, weno_num_stencils
3624 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3625 end do
3626 omega = alpha/sum(alpha)
3627 do q = 0, weno_num_stencils
3628 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
3629 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
3630 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
3631 end do
3632 else if (wenoz) then
3633 do q = 0, weno_num_stencils
3634 alpha(q) = d_cbr_y(q, k)*(1._wp + tau/beta(q))
3635 end do
3636 end if
3637 omega = alpha/sum(alpha)
3638
3639 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3640 end do
3641 end do
3642 end do
3643 end do
3644
3645# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3646#if defined(MFC_OpenACC)
3647# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3648!$acc end parallel loop
3649# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3650#elif defined(MFC_OpenMP)
3651# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3652
3653# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3654!$omp end target teams loop
3655# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3656#endif
3657 end if
3658# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3659# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3660# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3661 if (weno_dir == 3) then
3662
3663# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3664
3665# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3666#if defined(MFC_OpenACC)
3667# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3668!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3669# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3670#elif defined(MFC_OpenMP)
3671# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3672
3673# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3674
3675# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3676
3677# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3678!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3679# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3680!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3681# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3682#endif
3683 do l = is1_weno%beg, is1_weno%end
3684 do k = is2_weno%beg, is2_weno%end
3685 do j = is3_weno%beg, is3_weno%end
3686 do i = 1, v_size
3687 ! reconstruct from left side
3688
3689 alpha(:) = 0._wp
3690
3691 vp0 = v_rs_weno(j, k, l, i)
3692 vm1 = v_rs_weno(j, k, l - 1, i)
3693 vp1 = v_rs_weno(j, k, l + 1, i)
3694
3695 dvd(0) = vp1 - vp0
3696 dvd(-1) = vp0 - vm1
3697
3698 poly(0) = vp0 + poly_coef_cbl_z(l, 0, 0)*dvd(0)
3699 poly(1) = vp0 + poly_coef_cbl_z(l, 1, 0)*dvd(-1)
3700
3701 beta(0) = beta_coef_z(l, 0, 0)*dvd(0)*dvd(0) + weno_eps
3702 beta(1) = beta_coef_z(l, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3703
3704 if (wenojs) then
3705 do q = 0, weno_num_stencils
3706 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3707 end do
3708 else if (mapped_weno) then
3709 do q = 0, weno_num_stencils
3710 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3711 end do
3712 omega = alpha/sum(alpha)
3713 do q = 0, weno_num_stencils
3714 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
3715 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
3716 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
3717 end do
3718 else if (wenoz) then
3719 ! Borges, et al. (2008)
3720 tau = abs(beta(1) - beta(0))
3721 do q = 0, weno_num_stencils
3722 alpha(q) = d_cbl_z(q, l)*(1._wp + tau/beta(q))
3723 end do
3724 end if
3725 omega = alpha/sum(alpha)
3726
3727 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3728
3729 ! reconstruct from right side
3730
3731 poly(0) = vp0 + poly_coef_cbr_z(l, 0, 0)*dvd(0)
3732 poly(1) = vp0 + poly_coef_cbr_z(l, 1, 0)*dvd(-1)
3733
3734 if (wenojs) then
3735 do q = 0, weno_num_stencils
3736 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3737 end do
3738 else if (mapped_weno) then
3739 do q = 0, weno_num_stencils
3740 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3741 end do
3742 omega = alpha/sum(alpha)
3743 do q = 0, weno_num_stencils
3744 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
3745 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
3746 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
3747 end do
3748 else if (wenoz) then
3749 do q = 0, weno_num_stencils
3750 alpha(q) = d_cbr_z(q, l)*(1._wp + tau/beta(q))
3751 end do
3752 end if
3753 omega = alpha/sum(alpha)
3754
3755 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3756 end do
3757 end do
3758 end do
3759 end do
3760
3761# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3762#if defined(MFC_OpenACC)
3763# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3764!$acc end parallel loop
3765# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3766#elif defined(MFC_OpenMP)
3767# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3768
3769# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3770!$omp end target teams loop
3771# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3772#endif
3773 end if
3774# 1086 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3775 end if
3776 if (weno_order == 5) then
3777# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3778# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3779# 1094 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3780# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3781 if (weno_dir == 1) then
3782
3783# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3784
3785# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3786#if defined(MFC_OpenACC)
3787# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3788!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3789# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3790#elif defined(MFC_OpenMP)
3791# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3792
3793# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3794
3795# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3796
3797# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3798!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3799# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3800!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3801# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3802#endif
3803# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3804 do l = is3_weno%beg, is3_weno%end
3805 do k = is2_weno%beg, is2_weno%end
3806 do j = is1_weno%beg, is1_weno%end
3807
3808# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3809#if defined(MFC_OpenACC)
3810# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3811!$acc loop seq
3812# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3813#elif defined(MFC_OpenMP)
3814# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3815
3816# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3817#endif
3818 do i = 1, v_size
3819 ! reconstruct from left side
3820
3821 alpha(:) = 0._wp
3822
3823 vp0 = v_rs_weno(j, k, l, i)
3824 vm1 = v_rs_weno(j - 1, k, l, i)
3825 vm2 = v_rs_weno(j - 2, k, l, i)
3826 vp1 = v_rs_weno(j + 1, k, l, i)
3827 vp2 = v_rs_weno(j + 2, k, l, i)
3828
3829 dvd(1) = vp2 - vp1
3830 dvd(0) = vp1 - vp0
3831 dvd(-1) = vp0 - vm1
3832 dvd(-2) = vm1 - vm2
3833
3834 poly(0) = vp0 + poly_coef_cbl_x(j, 0, &
3835 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3836 poly(1) = vp0 + poly_coef_cbl_x(j, 1, &
3837 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3838 poly(2) = vp0 + poly_coef_cbl_x(j, 2, &
3839 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3840
3841 if (uniform_grid(1)) then
3842 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
3843 & + weno_eps
3844 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
3845 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
3846 & + weno_eps
3847 else
3848 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
3849 & 0, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3850 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
3851 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, &
3852 & 2)*dvd(-1)*dvd(-1) + weno_eps
3853 beta(2) = beta_coef_x(j, 2, &
3854 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3855 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3856 end if
3857
3858 if (wenojs) then
3859 do q = 0, weno_num_stencils
3860 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3861 end do
3862 else if (mapped_weno) then
3863 do q = 0, weno_num_stencils
3864 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3865 end do
3866 omega = alpha/sum(alpha)
3867 do q = 0, weno_num_stencils
3868 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3869 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3870 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3871 end do
3872 else if (wenoz) then
3873 ! Borges, et al. (2008)
3874
3875 tau = abs(beta(2) - beta(0)) ! Equation 25
3876
3877# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3878#if defined(MFC_OpenACC)
3879# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3880!$acc loop seq
3881# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3882#elif defined(MFC_OpenMP)
3883# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3884
3885# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3886#endif
3887 do q = 0, weno_num_stencils
3888 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3889 ! Equation 28 (note: weno_eps was already added to beta)
3890 end do
3891 else if (teno) then
3892 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3893 tau = abs(beta(2) - beta(0))
3894
3895# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3896#if defined(MFC_OpenACC)
3897# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3898!$acc loop seq
3899# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3900#elif defined(MFC_OpenMP)
3901# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3902
3903# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3904#endif
3905 do q = 0, weno_num_stencils
3906 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3907 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3908 alpha(q) = (alpha(q)**3._wp)**2._wp
3909 end do
3910 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3911
3912
3913# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3914#if defined(MFC_OpenACC)
3915# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3916!$acc loop seq
3917# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3918#elif defined(MFC_OpenMP)
3919# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3920
3921# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3922#endif
3923 do q = 0, weno_num_stencils
3924 if (omega(q) < teno_ct) then ! Equation 26
3925 delta(q) = 0._wp
3926 else
3927 delta(q) = 1._wp
3928 end if
3929 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3930 end do
3931 end if
3932
3933 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3934 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3935 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3936
3937 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3938
3939 ! reconstruct from right side
3940
3941 poly(0) = vp0 + poly_coef_cbr_x(j, 0, &
3942 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3943 poly(1) = vp0 + poly_coef_cbr_x(j, 1, &
3944 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3945 poly(2) = vp0 + poly_coef_cbr_x(j, 2, &
3946 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3947
3948 if (wenojs) then
3949 do q = 0, weno_num_stencils
3950 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3951 end do
3952 else if (mapped_weno) then
3953 do q = 0, weno_num_stencils
3954 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3955 end do
3956 omega = alpha/sum(alpha)
3957 do q = 0, weno_num_stencils
3958 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3959 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3960 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3961 end do
3962 else if (wenoz) then
3963
3964# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3965#if defined(MFC_OpenACC)
3966# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3967!$acc loop seq
3968# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3969#elif defined(MFC_OpenMP)
3970# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3971
3972# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3973#endif
3974 do q = 0, weno_num_stencils
3975 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3976 end do
3977 else if (teno) then
3978
3979# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3980#if defined(MFC_OpenACC)
3981# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3982!$acc loop seq
3983# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3984#elif defined(MFC_OpenMP)
3985# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3986
3987# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3988#endif
3989 do q = 0, weno_num_stencils
3990 alpha(q) = delta(q)*d_cbr_x(q, j)
3991 end do
3992 end if
3993
3994 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3995 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3996 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3997
3998 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3999 end do
4000 end do
4001 end do
4002 end do
4003
4004# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4005#if defined(MFC_OpenACC)
4006# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4007!$acc end parallel loop
4008# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4009#elif defined(MFC_OpenMP)
4010# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4011
4012# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4013!$omp end target teams loop
4014# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4015#endif
4016
4017 if (mp_weno) then
4018 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4019 end if
4020 end if
4021# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4022# 1094 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4023# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4024 if (weno_dir == 2) then
4025
4026# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4027
4028# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4029#if defined(MFC_OpenACC)
4030# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4031!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4032# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4033#elif defined(MFC_OpenMP)
4034# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4035
4036# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4037
4038# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4039
4040# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4041!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4042# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4043!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4044# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4045#endif
4046# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4047 do l = is3_weno%beg, is3_weno%end
4048 do k = is1_weno%beg, is1_weno%end
4049 do j = is2_weno%beg, is2_weno%end
4050
4051# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4052#if defined(MFC_OpenACC)
4053# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4054!$acc loop seq
4055# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4056#elif defined(MFC_OpenMP)
4057# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4058
4059# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4060#endif
4061 do i = 1, v_size
4062 ! reconstruct from left side
4063
4064 alpha(:) = 0._wp
4065
4066 vp0 = v_rs_weno(j, k, l, i)
4067 vm1 = v_rs_weno(j, k - 1, l, i)
4068 vm2 = v_rs_weno(j, k - 2, l, i)
4069 vp1 = v_rs_weno(j, k + 1, l, i)
4070 vp2 = v_rs_weno(j, k + 2, l, i)
4071
4072 dvd(1) = vp2 - vp1
4073 dvd(0) = vp1 - vp0
4074 dvd(-1) = vp0 - vm1
4075 dvd(-2) = vm1 - vm2
4076
4077 poly(0) = vp0 + poly_coef_cbl_y(k, 0, &
4078 & 0)*dvd(1) + poly_coef_cbl_y(k, 0, 1)*dvd(0)
4079 poly(1) = vp0 + poly_coef_cbl_y(k, 1, &
4080 & 0)*dvd(0) + poly_coef_cbl_y(k, 1, 1)*dvd(-1)
4081 poly(2) = vp0 + poly_coef_cbl_y(k, 2, &
4082 & 0)*dvd(-1) + poly_coef_cbl_y(k, 2, 1)*dvd(-2)
4083
4084 if (uniform_grid(2)) then
4085 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4086 & + weno_eps
4087 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4088 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4089 & + weno_eps
4090 else
4091 beta(0) = beta_coef_y(k, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4092 & 0, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 2)*dvd(0)*dvd(0) + weno_eps
4093 beta(1) = beta_coef_y(k, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4094 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, &
4095 & 2)*dvd(-1)*dvd(-1) + weno_eps
4096 beta(2) = beta_coef_y(k, 2, &
4097 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4098 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4099 end if
4100
4101 if (wenojs) then
4102 do q = 0, weno_num_stencils
4103 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4104 end do
4105 else if (mapped_weno) then
4106 do q = 0, weno_num_stencils
4107 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4108 end do
4109 omega = alpha/sum(alpha)
4110 do q = 0, weno_num_stencils
4111 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4112 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4113 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4114 end do
4115 else if (wenoz) then
4116 ! Borges, et al. (2008)
4117
4118 tau = abs(beta(2) - beta(0)) ! Equation 25
4119
4120# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4121#if defined(MFC_OpenACC)
4122# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4123!$acc loop seq
4124# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4125#elif defined(MFC_OpenMP)
4126# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4127
4128# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4129#endif
4130 do q = 0, weno_num_stencils
4131 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q)))
4132 ! Equation 28 (note: weno_eps was already added to beta)
4133 end do
4134 else if (teno) then
4135 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4136 tau = abs(beta(2) - beta(0))
4137
4138# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4139#if defined(MFC_OpenACC)
4140# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4141!$acc loop seq
4142# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4143#elif defined(MFC_OpenMP)
4144# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4145
4146# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4147#endif
4148 do q = 0, weno_num_stencils
4149 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4150 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4151 alpha(q) = (alpha(q)**3._wp)**2._wp
4152 end do
4153 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4154
4155
4156# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4157#if defined(MFC_OpenACC)
4158# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4159!$acc loop seq
4160# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4161#elif defined(MFC_OpenMP)
4162# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4163
4164# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4165#endif
4166 do q = 0, weno_num_stencils
4167 if (omega(q) < teno_ct) then ! Equation 26
4168 delta(q) = 0._wp
4169 else
4170 delta(q) = 1._wp
4171 end if
4172 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4173 end do
4174 end if
4175
4176 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4177 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4178 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4179
4180 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4181
4182 ! reconstruct from right side
4183
4184 poly(0) = vp0 + poly_coef_cbr_y(k, 0, &
4185 & 0)*dvd(1) + poly_coef_cbr_y(k, 0, 1)*dvd(0)
4186 poly(1) = vp0 + poly_coef_cbr_y(k, 1, &
4187 & 0)*dvd(0) + poly_coef_cbr_y(k, 1, 1)*dvd(-1)
4188 poly(2) = vp0 + poly_coef_cbr_y(k, 2, &
4189 & 0)*dvd(-1) + poly_coef_cbr_y(k, 2, 1)*dvd(-2)
4190
4191 if (wenojs) then
4192 do q = 0, weno_num_stencils
4193 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4194 end do
4195 else if (mapped_weno) then
4196 do q = 0, weno_num_stencils
4197 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4198 end do
4199 omega = alpha/sum(alpha)
4200 do q = 0, weno_num_stencils
4201 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4202 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4203 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4204 end do
4205 else if (wenoz) then
4206
4207# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4208#if defined(MFC_OpenACC)
4209# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4210!$acc loop seq
4211# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4212#elif defined(MFC_OpenMP)
4213# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4214
4215# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4216#endif
4217 do q = 0, weno_num_stencils
4218 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q)))
4219 end do
4220 else if (teno) then
4221
4222# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4223#if defined(MFC_OpenACC)
4224# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4225!$acc loop seq
4226# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4227#elif defined(MFC_OpenMP)
4228# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4229
4230# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4231#endif
4232 do q = 0, weno_num_stencils
4233 alpha(q) = delta(q)*d_cbr_y(q, k)
4234 end do
4235 end if
4236
4237 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4238 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4239 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4240
4241 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4242 end do
4243 end do
4244 end do
4245 end do
4246
4247# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4248#if defined(MFC_OpenACC)
4249# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4250!$acc end parallel loop
4251# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4252#elif defined(MFC_OpenMP)
4253# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4254
4255# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4256!$omp end target teams loop
4257# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4258#endif
4259
4260 if (mp_weno) then
4261 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4262 end if
4263 end if
4264# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4265# 1094 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4266# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4267 if (weno_dir == 3) then
4268
4269# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4270
4271# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4272#if defined(MFC_OpenACC)
4273# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4274!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4275# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4276#elif defined(MFC_OpenMP)
4277# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4278
4279# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4280
4281# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4282
4283# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4284!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4285# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4286!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4287# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4288#endif
4289# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4290 do l = is1_weno%beg, is1_weno%end
4291 do k = is2_weno%beg, is2_weno%end
4292 do j = is3_weno%beg, is3_weno%end
4293
4294# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4295#if defined(MFC_OpenACC)
4296# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4297!$acc loop seq
4298# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4299#elif defined(MFC_OpenMP)
4300# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4301
4302# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4303#endif
4304 do i = 1, v_size
4305 ! reconstruct from left side
4306
4307 alpha(:) = 0._wp
4308
4309 vp0 = v_rs_weno(j, k, l, i)
4310 vm1 = v_rs_weno(j, k, l - 1, i)
4311 vm2 = v_rs_weno(j, k, l - 2, i)
4312 vp1 = v_rs_weno(j, k, l + 1, i)
4313 vp2 = v_rs_weno(j, k, l + 2, i)
4314
4315 dvd(1) = vp2 - vp1
4316 dvd(0) = vp1 - vp0
4317 dvd(-1) = vp0 - vm1
4318 dvd(-2) = vm1 - vm2
4319
4320 poly(0) = vp0 + poly_coef_cbl_z(l, 0, &
4321 & 0)*dvd(1) + poly_coef_cbl_z(l, 0, 1)*dvd(0)
4322 poly(1) = vp0 + poly_coef_cbl_z(l, 1, &
4323 & 0)*dvd(0) + poly_coef_cbl_z(l, 1, 1)*dvd(-1)
4324 poly(2) = vp0 + poly_coef_cbl_z(l, 2, &
4325 & 0)*dvd(-1) + poly_coef_cbl_z(l, 2, 1)*dvd(-2)
4326
4327 if (uniform_grid(3)) then
4328 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4329 & + weno_eps
4330 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4331 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4332 & + weno_eps
4333 else
4334 beta(0) = beta_coef_z(l, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
4335 & 0, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 2)*dvd(0)*dvd(0) + weno_eps
4336 beta(1) = beta_coef_z(l, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
4337 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, &
4338 & 2)*dvd(-1)*dvd(-1) + weno_eps
4339 beta(2) = beta_coef_z(l, 2, &
4340 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
4341 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4342 end if
4343
4344 if (wenojs) then
4345 do q = 0, weno_num_stencils
4346 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4347 end do
4348 else if (mapped_weno) then
4349 do q = 0, weno_num_stencils
4350 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4351 end do
4352 omega = alpha/sum(alpha)
4353 do q = 0, weno_num_stencils
4354 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
4355 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
4356 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
4357 end do
4358 else if (wenoz) then
4359 ! Borges, et al. (2008)
4360
4361 tau = abs(beta(2) - beta(0)) ! Equation 25
4362
4363# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4364#if defined(MFC_OpenACC)
4365# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4366!$acc loop seq
4367# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4368#elif defined(MFC_OpenMP)
4369# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4370
4371# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4372#endif
4373 do q = 0, weno_num_stencils
4374 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q)))
4375 ! Equation 28 (note: weno_eps was already added to beta)
4376 end do
4377 else if (teno) then
4378 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4379 tau = abs(beta(2) - beta(0))
4380
4381# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4382#if defined(MFC_OpenACC)
4383# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4384!$acc loop seq
4385# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4386#elif defined(MFC_OpenMP)
4387# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4388
4389# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4390#endif
4391 do q = 0, weno_num_stencils
4392 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4393 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4394 alpha(q) = (alpha(q)**3._wp)**2._wp
4395 end do
4396 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4397
4398
4399# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4400#if defined(MFC_OpenACC)
4401# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4402!$acc loop seq
4403# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4404#elif defined(MFC_OpenMP)
4405# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4406
4407# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4408#endif
4409 do q = 0, weno_num_stencils
4410 if (omega(q) < teno_ct) then ! Equation 26
4411 delta(q) = 0._wp
4412 else
4413 delta(q) = 1._wp
4414 end if
4415 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
4416 end do
4417 end if
4418
4419 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4420 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4421 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4422
4423 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4424
4425 ! reconstruct from right side
4426
4427 poly(0) = vp0 + poly_coef_cbr_z(l, 0, &
4428 & 0)*dvd(1) + poly_coef_cbr_z(l, 0, 1)*dvd(0)
4429 poly(1) = vp0 + poly_coef_cbr_z(l, 1, &
4430 & 0)*dvd(0) + poly_coef_cbr_z(l, 1, 1)*dvd(-1)
4431 poly(2) = vp0 + poly_coef_cbr_z(l, 2, &
4432 & 0)*dvd(-1) + poly_coef_cbr_z(l, 2, 1)*dvd(-2)
4433
4434 if (wenojs) then
4435 do q = 0, weno_num_stencils
4436 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4437 end do
4438 else if (mapped_weno) then
4439 do q = 0, weno_num_stencils
4440 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4441 end do
4442 omega = alpha/sum(alpha)
4443 do q = 0, weno_num_stencils
4444 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
4445 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
4446 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
4447 end do
4448 else if (wenoz) then
4449
4450# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4451#if defined(MFC_OpenACC)
4452# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4453!$acc loop seq
4454# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4455#elif defined(MFC_OpenMP)
4456# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4457
4458# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4459#endif
4460 do q = 0, weno_num_stencils
4461 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q)))
4462 end do
4463 else if (teno) then
4464
4465# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4466#if defined(MFC_OpenACC)
4467# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4468!$acc loop seq
4469# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4470#elif defined(MFC_OpenMP)
4471# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4472
4473# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4474#endif
4475 do q = 0, weno_num_stencils
4476 alpha(q) = delta(q)*d_cbr_z(q, l)
4477 end do
4478 end if
4479
4480 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4481 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4482 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4483
4484 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4485 end do
4486 end do
4487 end do
4488 end do
4489
4490# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4491#if defined(MFC_OpenACC)
4492# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4493!$acc end parallel loop
4494# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4495#elif defined(MFC_OpenMP)
4496# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4497
4498# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4499!$omp end target teams loop
4500# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4501#endif
4502
4503 if (mp_weno) then
4504 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4505 end if
4506 end if
4507# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4508# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4509 end if
4510 if (weno_order == 7) then
4511# 1248 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4512# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4513# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4514# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4515 if (weno_dir == 1) then
4516
4517# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4518
4519# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4520#if defined(MFC_OpenACC)
4521# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4522!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4523# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4524#elif defined(MFC_OpenMP)
4525# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4526
4527# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4528
4529# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4530
4531# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4532!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4533# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4534!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4535# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4536#endif
4537# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4538 do l = is3_weno%beg, is3_weno%end
4539 do k = is2_weno%beg, is2_weno%end
4540 do j = is1_weno%beg, is1_weno%end
4541
4542# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4543#if defined(MFC_OpenACC)
4544# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4545!$acc loop seq
4546# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4547#elif defined(MFC_OpenMP)
4548# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4549
4550# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4551#endif
4552 do i = 1, v_size
4553 alpha(:) = 0._wp
4554
4555 vp0 = v_rs_weno(j, k, l, i)
4556 vm1 = v_rs_weno(j - 1, k, l, i)
4557 vm2 = v_rs_weno(j - 2, k, l, i)
4558 vm3 = v_rs_weno(j - 3, k, l, i)
4559 vp1 = v_rs_weno(j + 1, k, l, i)
4560 vp2 = v_rs_weno(j + 2, k, l, i)
4561 vp3 = v_rs_weno(j + 3, k, l, i)
4562
4563 if (teno) then
4564 v(-3) = vm3
4565 v(-2) = vm2
4566 v(-1) = vm1
4567 v(0) = vp0
4568 v(1) = vp1
4569 v(2) = vp2
4570 v(3) = vp3
4571 end if
4572
4573 if (.not. teno) then
4574 dvd(2) = vp3 - vp2
4575 dvd(1) = vp2 - vp1
4576 dvd(0) = vp1 - vp0
4577 dvd(-1) = vp0 - vm1
4578 dvd(-2) = vm1 - vm2
4579 dvd(-3) = vm2 - vm3
4580
4581 poly(3) = vp0 + poly_coef_cbl_x(j, 0, &
4582 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, &
4583 & 1)*dvd(1) + poly_coef_cbl_x(j, 0, 2)*dvd(0)
4584 poly(2) = vp0 + poly_coef_cbl_x(j, 1, &
4585 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, &
4586 & 1)*dvd(0) + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
4587 poly(1) = vp0 + poly_coef_cbl_x(j, 2, &
4588 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4589 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4590 poly(0) = vp0 + poly_coef_cbl_x(j, 3, &
4591 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4592 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4593 else
4594# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4595 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4596 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4597 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4598 ! to keep the stencil order to reuse the beta coefficients
4599 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4600 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4601 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4602 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4603 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4604# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4605 end if
4606
4607 if (.not. teno) then
4608 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, &
4609 & 0, 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4610 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4611 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4612 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4613
4614 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
4615 & 1, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4616 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4617 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4618 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4619
4620 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
4621 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4622 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4623 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4624 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4625
4626 beta(0) = beta_coef_x(j, 3, &
4627 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4628 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4629 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4630 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4631 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4632 else
4633# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4634 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4635 ! & Tang, 2019) Section 3.2
4636 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4637 & **2._wp)/4._wp + weno_eps
4638 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4639 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4640 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4641 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4642
4643 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4644 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4645 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4646
4647 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4648 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4649 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4650# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4651 end if
4652
4653 if (wenojs) then
4654 do q = 0, weno_num_stencils
4655 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4656 end do
4657 else if (mapped_weno) then
4658 do q = 0, weno_num_stencils
4659 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4660 end do
4661 omega = alpha/sum(alpha)
4662 do q = 0, weno_num_stencils
4663 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
4664 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
4665 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
4666 end do
4667 else if (wenoz) then
4668 ! Castro, et al. (2010) Don & Borges (2013) also helps
4669 tau = abs(beta(3) - beta(0)) ! Equation 50
4670
4671# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4672#if defined(MFC_OpenACC)
4673# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4674!$acc loop seq
4675# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4676#elif defined(MFC_OpenMP)
4677# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4678
4679# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4680#endif
4681 do q = 0, weno_num_stencils
4682 ! wenoz_q = 2,3,4 for stability
4683 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4684 end do
4685 else if (teno) then
4686# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4687 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4688 alpha = 1._wp + tau/beta
4689 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4690 omega = alpha/sum(alpha)
4691
4692
4693# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4694#if defined(MFC_OpenACC)
4695# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4696!$acc loop seq
4697# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4698#elif defined(MFC_OpenMP)
4699# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4700
4701# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4702#endif
4703 do q = 0, weno_num_stencils
4704 if (omega(q) < teno_ct) then ! Equation 26
4705 delta(q) = 0._wp
4706 else
4707 delta(q) = 1._wp
4708 end if
4709 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4710 end do
4711# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4712 end if
4713
4714 omega = alpha/sum(alpha)
4715
4716 vl_rs_vf_x(j, k, l, &
4717 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4718
4719 if (teno) then
4720# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4721 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4722# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4723 end if
4724
4725 if (.not. teno) then
4726 poly(3) = vp0 + poly_coef_cbr_x(j, 0, &
4727 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, &
4728 & 1)*dvd(1) + poly_coef_cbr_x(j, 0, 2)*dvd(0)
4729 poly(2) = vp0 + poly_coef_cbr_x(j, 1, &
4730 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, &
4731 & 1)*dvd(0) + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
4732 poly(1) = vp0 + poly_coef_cbr_x(j, 2, &
4733 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4734 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4735 poly(0) = vp0 + poly_coef_cbr_x(j, 3, &
4736 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4737 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4738 else
4739# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4740 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4741 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4742 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4743 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4744 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4745# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4746 end if
4747
4748 if (wenojs) then
4749 do q = 0, weno_num_stencils
4750 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4751 end do
4752 else if (mapped_weno) then
4753 do q = 0, weno_num_stencils
4754 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4755 end do
4756 omega = alpha/sum(alpha)
4757 do q = 0, weno_num_stencils
4758 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
4759 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
4760 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
4761 end do
4762 else if (wenoz) then
4763
4764# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4765#if defined(MFC_OpenACC)
4766# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4767!$acc loop seq
4768# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4769#elif defined(MFC_OpenMP)
4770# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4771
4772# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4773#endif
4774 do q = 0, weno_num_stencils
4775 ! wenoz_q = 2,3,4 for stability
4776 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4777 end do
4778 else if (teno) then
4779
4780# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4781#if defined(MFC_OpenACC)
4782# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4783!$acc loop seq
4784# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4785#elif defined(MFC_OpenMP)
4786# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4787
4788# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4789#endif
4790 do q = 0, weno_num_stencils
4791 alpha(q) = delta(q)*d_cbr_x(q, j)
4792 end do
4793 end if
4794
4795 omega = alpha/sum(alpha)
4796
4797 vr_rs_vf_x(j, k, l, &
4798 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4799
4800 if (teno) then
4801# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4802 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4803# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4804 end if
4805 end do
4806 end do
4807 end do
4808 end do
4809
4810# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4811#if defined(MFC_OpenACC)
4812# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4813!$acc end parallel loop
4814# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4815#elif defined(MFC_OpenMP)
4816# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4817
4818# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4819!$omp end target teams loop
4820# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4821#endif
4822 end if
4823# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4824# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4825# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4826 if (weno_dir == 2) then
4827
4828# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4829
4830# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4831#if defined(MFC_OpenACC)
4832# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4833!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4834# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4835#elif defined(MFC_OpenMP)
4836# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4837
4838# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4839
4840# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4841
4842# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4843!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4844# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4845!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4846# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4847#endif
4848# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4849 do l = is3_weno%beg, is3_weno%end
4850 do k = is1_weno%beg, is1_weno%end
4851 do j = is2_weno%beg, is2_weno%end
4852
4853# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4854#if defined(MFC_OpenACC)
4855# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4856!$acc loop seq
4857# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4858#elif defined(MFC_OpenMP)
4859# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4860
4861# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4862#endif
4863 do i = 1, v_size
4864 alpha(:) = 0._wp
4865
4866 vp0 = v_rs_weno(j, k, l, i)
4867 vm1 = v_rs_weno(j, k - 1, l, i)
4868 vm2 = v_rs_weno(j, k - 2, l, i)
4869 vm3 = v_rs_weno(j, k - 3, l, i)
4870 vp1 = v_rs_weno(j, k + 1, l, i)
4871 vp2 = v_rs_weno(j, k + 2, l, i)
4872 vp3 = v_rs_weno(j, k + 3, l, i)
4873
4874 if (teno) then
4875 v(-3) = vm3
4876 v(-2) = vm2
4877 v(-1) = vm1
4878 v(0) = vp0
4879 v(1) = vp1
4880 v(2) = vp2
4881 v(3) = vp3
4882 end if
4883
4884 if (.not. teno) then
4885 dvd(2) = vp3 - vp2
4886 dvd(1) = vp2 - vp1
4887 dvd(0) = vp1 - vp0
4888 dvd(-1) = vp0 - vm1
4889 dvd(-2) = vm1 - vm2
4890 dvd(-3) = vm2 - vm3
4891
4892 poly(3) = vp0 + poly_coef_cbl_y(k, 0, &
4893 & 0)*dvd(2) + poly_coef_cbl_y(k, 0, &
4894 & 1)*dvd(1) + poly_coef_cbl_y(k, 0, 2)*dvd(0)
4895 poly(2) = vp0 + poly_coef_cbl_y(k, 1, &
4896 & 0)*dvd(1) + poly_coef_cbl_y(k, 1, &
4897 & 1)*dvd(0) + poly_coef_cbl_y(k, 1, 2)*dvd(-1)
4898 poly(1) = vp0 + poly_coef_cbl_y(k, 2, &
4899 & 0)*dvd(0) + poly_coef_cbl_y(k, 2, &
4900 & 1)*dvd(-1) + poly_coef_cbl_y(k, 2, 2)*dvd(-2)
4901 poly(0) = vp0 + poly_coef_cbl_y(k, 3, &
4902 & 0)*dvd(-1) + poly_coef_cbl_y(k, 3, &
4903 & 1)*dvd(-2) + poly_coef_cbl_y(k, 3, 2)*dvd(-3)
4904 else
4905# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4906 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4907 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4908 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4909 ! to keep the stencil order to reuse the beta coefficients
4910 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4911 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4912 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4913 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4914 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4915# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4916 end if
4917
4918 if (.not. teno) then
4919 beta(3) = beta_coef_y(k, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(k, &
4920 & 0, 1)*dvd(2)*dvd(1) + beta_coef_y(k, 0, &
4921 & 2)*dvd(2)*dvd(0) + beta_coef_y(k, 0, &
4922 & 3)*dvd(1)*dvd(1) + beta_coef_y(k, 0, &
4923 & 4)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 5)*dvd(0)*dvd(0) + weno_eps
4924
4925 beta(2) = beta_coef_y(k, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4926 & 1, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 1, &
4927 & 2)*dvd(1)*dvd(-1) + beta_coef_y(k, 1, &
4928 & 3)*dvd(0)*dvd(0) + beta_coef_y(k, 1, &
4929 & 4)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4930
4931 beta(1) = beta_coef_y(k, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4932 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 2, &
4933 & 2)*dvd(0)*dvd(-2) + beta_coef_y(k, 2, &
4934 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4935 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4936
4937 beta(0) = beta_coef_y(k, 3, &
4938 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 3, &
4939 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 3, &
4940 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(k, 3, &
4941 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(k, 3, &
4942 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(k, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4943 else
4944# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4945 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4946 ! & Tang, 2019) Section 3.2
4947 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4948 & **2._wp)/4._wp + weno_eps
4949 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4950 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4951 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4952 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4953
4954 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4955 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4956 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4957
4958 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4959 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4960 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4961# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4962 end if
4963
4964 if (wenojs) then
4965 do q = 0, weno_num_stencils
4966 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4967 end do
4968 else if (mapped_weno) then
4969 do q = 0, weno_num_stencils
4970 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4971 end do
4972 omega = alpha/sum(alpha)
4973 do q = 0, weno_num_stencils
4974 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4975 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4976 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4977 end do
4978 else if (wenoz) then
4979 ! Castro, et al. (2010) Don & Borges (2013) also helps
4980 tau = abs(beta(3) - beta(0)) ! Equation 50
4981
4982# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4983#if defined(MFC_OpenACC)
4984# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4985!$acc loop seq
4986# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4987#elif defined(MFC_OpenMP)
4988# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4989
4990# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4991#endif
4992 do q = 0, weno_num_stencils
4993 ! wenoz_q = 2,3,4 for stability
4994 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
4995 end do
4996 else if (teno) then
4997# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4998 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4999 alpha = 1._wp + tau/beta
5000 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5001 omega = alpha/sum(alpha)
5002
5003
5004# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5005#if defined(MFC_OpenACC)
5006# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5007!$acc loop seq
5008# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5009#elif defined(MFC_OpenMP)
5010# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5011
5012# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5013#endif
5014 do q = 0, weno_num_stencils
5015 if (omega(q) < teno_ct) then ! Equation 26
5016 delta(q) = 0._wp
5017 else
5018 delta(q) = 1._wp
5019 end if
5020 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
5021 end do
5022# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5023 end if
5024
5025 omega = alpha/sum(alpha)
5026
5027 vl_rs_vf_x(j, k, l, &
5028 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5029
5030 if (teno) then
5031# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5032 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5033# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5034 end if
5035
5036 if (.not. teno) then
5037 poly(3) = vp0 + poly_coef_cbr_y(k, 0, &
5038 & 0)*dvd(2) + poly_coef_cbr_y(k, 0, &
5039 & 1)*dvd(1) + poly_coef_cbr_y(k, 0, 2)*dvd(0)
5040 poly(2) = vp0 + poly_coef_cbr_y(k, 1, &
5041 & 0)*dvd(1) + poly_coef_cbr_y(k, 1, &
5042 & 1)*dvd(0) + poly_coef_cbr_y(k, 1, 2)*dvd(-1)
5043 poly(1) = vp0 + poly_coef_cbr_y(k, 2, &
5044 & 0)*dvd(0) + poly_coef_cbr_y(k, 2, &
5045 & 1)*dvd(-1) + poly_coef_cbr_y(k, 2, 2)*dvd(-2)
5046 poly(0) = vp0 + poly_coef_cbr_y(k, 3, &
5047 & 0)*dvd(-1) + poly_coef_cbr_y(k, 3, &
5048 & 1)*dvd(-2) + poly_coef_cbr_y(k, 3, 2)*dvd(-3)
5049 else
5050# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5051 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5052 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5053 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5054 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5055 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5056# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5057 end if
5058
5059 if (wenojs) then
5060 do q = 0, weno_num_stencils
5061 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
5062 end do
5063 else if (mapped_weno) then
5064 do q = 0, weno_num_stencils
5065 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
5066 end do
5067 omega = alpha/sum(alpha)
5068 do q = 0, weno_num_stencils
5069 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
5070 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
5071 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
5072 end do
5073 else if (wenoz) then
5074
5075# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5076#if defined(MFC_OpenACC)
5077# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5078!$acc loop seq
5079# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5080#elif defined(MFC_OpenMP)
5081# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5082
5083# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5084#endif
5085 do q = 0, weno_num_stencils
5086 ! wenoz_q = 2,3,4 for stability
5087 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
5088 end do
5089 else if (teno) then
5090
5091# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5092#if defined(MFC_OpenACC)
5093# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5094!$acc loop seq
5095# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5096#elif defined(MFC_OpenMP)
5097# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5098
5099# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5100#endif
5101 do q = 0, weno_num_stencils
5102 alpha(q) = delta(q)*d_cbr_y(q, k)
5103 end do
5104 end if
5105
5106 omega = alpha/sum(alpha)
5107
5108 vr_rs_vf_x(j, k, l, &
5109 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5110
5111 if (teno) then
5112# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5113 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5114# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5115 end if
5116 end do
5117 end do
5118 end do
5119 end do
5120
5121# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5122#if defined(MFC_OpenACC)
5123# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5124!$acc end parallel loop
5125# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5126#elif defined(MFC_OpenMP)
5127# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5128
5129# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5130!$omp end target teams loop
5131# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5132#endif
5133 end if
5134# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5135# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5136# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5137 if (weno_dir == 3) then
5138
5139# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5140
5141# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5142#if defined(MFC_OpenACC)
5143# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5144!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5145# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5146#elif defined(MFC_OpenMP)
5147# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5148
5149# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5150
5151# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5152
5153# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5154!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5155# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5156!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5157# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5158#endif
5159# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5160 do l = is1_weno%beg, is1_weno%end
5161 do k = is2_weno%beg, is2_weno%end
5162 do j = is3_weno%beg, is3_weno%end
5163
5164# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5165#if defined(MFC_OpenACC)
5166# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5167!$acc loop seq
5168# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5169#elif defined(MFC_OpenMP)
5170# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5171
5172# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5173#endif
5174 do i = 1, v_size
5175 alpha(:) = 0._wp
5176
5177 vp0 = v_rs_weno(j, k, l, i)
5178 vm1 = v_rs_weno(j, k, l - 1, i)
5179 vm2 = v_rs_weno(j, k, l - 2, i)
5180 vm3 = v_rs_weno(j, k, l - 3, i)
5181 vp1 = v_rs_weno(j, k, l + 1, i)
5182 vp2 = v_rs_weno(j, k, l + 2, i)
5183 vp3 = v_rs_weno(j, k, l + 3, i)
5184
5185 if (teno) then
5186 v(-3) = vm3
5187 v(-2) = vm2
5188 v(-1) = vm1
5189 v(0) = vp0
5190 v(1) = vp1
5191 v(2) = vp2
5192 v(3) = vp3
5193 end if
5194
5195 if (.not. teno) then
5196 dvd(2) = vp3 - vp2
5197 dvd(1) = vp2 - vp1
5198 dvd(0) = vp1 - vp0
5199 dvd(-1) = vp0 - vm1
5200 dvd(-2) = vm1 - vm2
5201 dvd(-3) = vm2 - vm3
5202
5203 poly(3) = vp0 + poly_coef_cbl_z(l, 0, &
5204 & 0)*dvd(2) + poly_coef_cbl_z(l, 0, &
5205 & 1)*dvd(1) + poly_coef_cbl_z(l, 0, 2)*dvd(0)
5206 poly(2) = vp0 + poly_coef_cbl_z(l, 1, &
5207 & 0)*dvd(1) + poly_coef_cbl_z(l, 1, &
5208 & 1)*dvd(0) + poly_coef_cbl_z(l, 1, 2)*dvd(-1)
5209 poly(1) = vp0 + poly_coef_cbl_z(l, 2, &
5210 & 0)*dvd(0) + poly_coef_cbl_z(l, 2, &
5211 & 1)*dvd(-1) + poly_coef_cbl_z(l, 2, 2)*dvd(-2)
5212 poly(0) = vp0 + poly_coef_cbl_z(l, 3, &
5213 & 0)*dvd(-1) + poly_coef_cbl_z(l, 3, &
5214 & 1)*dvd(-2) + poly_coef_cbl_z(l, 3, 2)*dvd(-3)
5215 else
5216# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5217 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
5218 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
5219 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
5220 ! to keep the stencil order to reuse the beta coefficients
5221 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
5222 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
5223 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
5224 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
5225 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
5226# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5227 end if
5228
5229 if (.not. teno) then
5230 beta(3) = beta_coef_z(l, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(l, &
5231 & 0, 1)*dvd(2)*dvd(1) + beta_coef_z(l, 0, &
5232 & 2)*dvd(2)*dvd(0) + beta_coef_z(l, 0, &
5233 & 3)*dvd(1)*dvd(1) + beta_coef_z(l, 0, &
5234 & 4)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 5)*dvd(0)*dvd(0) + weno_eps
5235
5236 beta(2) = beta_coef_z(l, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
5237 & 1, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 1, &
5238 & 2)*dvd(1)*dvd(-1) + beta_coef_z(l, 1, &
5239 & 3)*dvd(0)*dvd(0) + beta_coef_z(l, 1, &
5240 & 4)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
5241
5242 beta(1) = beta_coef_z(l, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
5243 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 2, &
5244 & 2)*dvd(0)*dvd(-2) + beta_coef_z(l, 2, &
5245 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
5246 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
5247
5248 beta(0) = beta_coef_z(l, 3, &
5249 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 3, &
5250 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 3, &
5251 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(l, 3, &
5252 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(l, 3, &
5253 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(l, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5254 else
5255# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5256 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5257 ! & Tang, 2019) Section 3.2
5258 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5259 & **2._wp)/4._wp + weno_eps
5260 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5261 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5262 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5263 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5264
5265 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5266 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5267 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5268
5269 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5270 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5271 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5272# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5273 end if
5274
5275 if (wenojs) then
5276 do q = 0, weno_num_stencils
5277 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5278 end do
5279 else if (mapped_weno) then
5280 do q = 0, weno_num_stencils
5281 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5282 end do
5283 omega = alpha/sum(alpha)
5284 do q = 0, weno_num_stencils
5285 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
5286 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
5287 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
5288 end do
5289 else if (wenoz) then
5290 ! Castro, et al. (2010) Don & Borges (2013) also helps
5291 tau = abs(beta(3) - beta(0)) ! Equation 50
5292
5293# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5294#if defined(MFC_OpenACC)
5295# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5296!$acc loop seq
5297# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5298#elif defined(MFC_OpenMP)
5299# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5300
5301# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5302#endif
5303 do q = 0, weno_num_stencils
5304 ! wenoz_q = 2,3,4 for stability
5305 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5306 end do
5307 else if (teno) then
5308# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5309 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5310 alpha = 1._wp + tau/beta
5311 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5312 omega = alpha/sum(alpha)
5313
5314
5315# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5316#if defined(MFC_OpenACC)
5317# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5318!$acc loop seq
5319# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5320#elif defined(MFC_OpenMP)
5321# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5322
5323# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5324#endif
5325 do q = 0, weno_num_stencils
5326 if (omega(q) < teno_ct) then ! Equation 26
5327 delta(q) = 0._wp
5328 else
5329 delta(q) = 1._wp
5330 end if
5331 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
5332 end do
5333# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5334 end if
5335
5336 omega = alpha/sum(alpha)
5337
5338 vl_rs_vf_x(j, k, l, &
5339 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5340
5341 if (teno) then
5342# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5343 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5344# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5345 end if
5346
5347 if (.not. teno) then
5348 poly(3) = vp0 + poly_coef_cbr_z(l, 0, &
5349 & 0)*dvd(2) + poly_coef_cbr_z(l, 0, &
5350 & 1)*dvd(1) + poly_coef_cbr_z(l, 0, 2)*dvd(0)
5351 poly(2) = vp0 + poly_coef_cbr_z(l, 1, &
5352 & 0)*dvd(1) + poly_coef_cbr_z(l, 1, &
5353 & 1)*dvd(0) + poly_coef_cbr_z(l, 1, 2)*dvd(-1)
5354 poly(1) = vp0 + poly_coef_cbr_z(l, 2, &
5355 & 0)*dvd(0) + poly_coef_cbr_z(l, 2, &
5356 & 1)*dvd(-1) + poly_coef_cbr_z(l, 2, 2)*dvd(-2)
5357 poly(0) = vp0 + poly_coef_cbr_z(l, 3, &
5358 & 0)*dvd(-1) + poly_coef_cbr_z(l, 3, &
5359 & 1)*dvd(-2) + poly_coef_cbr_z(l, 3, 2)*dvd(-3)
5360 else
5361# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5362 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5363 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5364 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5365 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5366 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5367# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5368 end if
5369
5370 if (wenojs) then
5371 do q = 0, weno_num_stencils
5372 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5373 end do
5374 else if (mapped_weno) then
5375 do q = 0, weno_num_stencils
5376 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5377 end do
5378 omega = alpha/sum(alpha)
5379 do q = 0, weno_num_stencils
5380 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
5381 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
5382 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
5383 end do
5384 else if (wenoz) then
5385
5386# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5387#if defined(MFC_OpenACC)
5388# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5389!$acc loop seq
5390# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5391#elif defined(MFC_OpenMP)
5392# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5393
5394# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5395#endif
5396 do q = 0, weno_num_stencils
5397 ! wenoz_q = 2,3,4 for stability
5398 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5399 end do
5400 else if (teno) then
5401
5402# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5403#if defined(MFC_OpenACC)
5404# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5405!$acc loop seq
5406# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5407#elif defined(MFC_OpenMP)
5408# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5409
5410# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5411#endif
5412 do q = 0, weno_num_stencils
5413 alpha(q) = delta(q)*d_cbr_z(q, l)
5414 end do
5415 end if
5416
5417 omega = alpha/sum(alpha)
5418
5419 vr_rs_vf_x(j, k, l, &
5420 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5421
5422 if (teno) then
5423# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5424 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5425# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5426 end if
5427 end do
5428 end do
5429 end do
5430 end do
5431
5432# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5433#if defined(MFC_OpenACC)
5434# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5435!$acc end parallel loop
5436# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5437#elif defined(MFC_OpenMP)
5438# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5439
5440# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5441!$omp end target teams loop
5442# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5443#endif
5444 end if
5445# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5446# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5447 end if
5448
5449 if (int_comp > 0 .and. v_size >= eqn_idx%adv%end) then
5450 call nvtxstartrange("WENO-INTCOMP")
5451 call s_thinc_compression(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno, is2_weno, is3_weno)
5452 call nvtxendrange()
5453 end if
5454
5455 end subroutine s_weno
5456
5457 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5458 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf, weno_dir)
5459
5460 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5461 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5462 integer, intent(in) :: weno_dir
5463 integer :: i, j, k, l
5464 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5465 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5466 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5467 ! the cell- average variables.
5468 real(wp) :: vL_UL, vR_UL
5469 real(wp) :: vL_MD, vR_MD
5470 real(wp) :: vL_LC, vR_LC
5471 real(wp) :: vL_min, vR_min
5472 real(wp) :: vL_max, vR_max
5473 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5474 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5475 real(wp), parameter :: alpha_mp = 2._wp
5476 real(wp), parameter :: beta_mp = 4._wp/3._wp
5477 real(wp) :: vp0, vp1, vp2, vm1, vm2
5478
5479# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5480# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5481# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5482 if (weno_dir == 1) then
5483
5484# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5485
5486# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5487#if defined(MFC_OpenACC)
5488# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5489!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5490# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5491#elif defined(MFC_OpenMP)
5492# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5493
5494# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5495
5496# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5497
5498# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5499!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5500# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5501!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5502# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5503#endif
5504 do l = is3_weno%beg, is3_weno%end
5505 do k = is2_weno%beg, is2_weno%end
5506 do j = is1_weno%beg, is1_weno%end
5507 do i = 1, v_size
5508 ! Second-order undivided differences for curvature estimation
5509
5510 vp0 = v_rs_ws(j, k, l, i)
5511 vm1 = v_rs_ws(j - 1, k, l, i)
5512 vm2 = v_rs_ws(j - 2, k, l, i)
5513 vp1 = v_rs_ws(j + 1, k, l, i)
5514 vp2 = v_rs_ws(j + 2, k, l, i)
5515
5516 d(-1) = vp0 + vm2 - vm1*2._wp
5517 d(0) = vp1 + vm1 - vp0*2._wp
5518 d(1) = vp2 + vp0 - vp1*2._wp
5519
5520 ! Median function for oscillation detection
5521 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5522 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5523 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5524 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5525
5526 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5527 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5528 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5529
5530 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5531
5532 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5533
5534 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5535
5536 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5537
5538 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5539
5540 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, &
5541 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5542 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5543 ! END: Left Monotonicity Preserving Bound
5544
5545 ! Right Monotonicity Preserving Bound
5546 d(-1) = vp0 + vm2 - vm1*2._wp
5547 d(0) = vp1 + vm1 - vp0*2._wp
5548 d(1) = vp2 + vp0 - vp1*2._wp
5549
5550 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5551 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5552 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5553
5554 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5555 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5556 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5557 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5558
5559 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5560
5561 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5562
5563 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5564
5565 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5566
5567 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5568
5569 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, &
5570 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5571 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5572 ! END: Right Monotonicity Preserving Bound
5573 end do
5574 end do
5575 end do
5576 end do
5577
5578# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5579#if defined(MFC_OpenACC)
5580# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5581!$acc end parallel loop
5582# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5583#elif defined(MFC_OpenMP)
5584# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5585
5586# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5587!$omp end target teams loop
5588# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5589#endif
5590 end if
5591# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5592# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5593# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5594 if (weno_dir == 2) then
5595
5596# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5597
5598# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5599#if defined(MFC_OpenACC)
5600# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5601!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5602# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5603#elif defined(MFC_OpenMP)
5604# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5605
5606# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5607
5608# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5609
5610# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5611!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5612# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5613!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5614# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5615#endif
5616 do l = is3_weno%beg, is3_weno%end
5617 do k = is1_weno%beg, is1_weno%end
5618 do j = is2_weno%beg, is2_weno%end
5619 do i = 1, v_size
5620 ! Second-order undivided differences for curvature estimation
5621
5622 vp0 = v_rs_ws(j, k, l, i)
5623 vm1 = v_rs_ws(j, k - 1, l, i)
5624 vm2 = v_rs_ws(j, k - 2, l, i)
5625 vp1 = v_rs_ws(j, k + 1, l, i)
5626 vp2 = v_rs_ws(j, k + 2, l, i)
5627
5628 d(-1) = vp0 + vm2 - vm1*2._wp
5629 d(0) = vp1 + vm1 - vp0*2._wp
5630 d(1) = vp2 + vp0 - vp1*2._wp
5631
5632 ! Median function for oscillation detection
5633 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5634 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5635 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5636 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5637
5638 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5639 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5640 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5641
5642 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5643
5644 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5645
5646 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5647
5648 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5649
5650 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5651
5652 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, &
5653 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5654 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5655 ! END: Left Monotonicity Preserving Bound
5656
5657 ! Right Monotonicity Preserving Bound
5658 d(-1) = vp0 + vm2 - vm1*2._wp
5659 d(0) = vp1 + vm1 - vp0*2._wp
5660 d(1) = vp2 + vp0 - vp1*2._wp
5661
5662 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5663 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5664 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5665
5666 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5667 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5668 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5669 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5670
5671 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5672
5673 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5674
5675 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5676
5677 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5678
5679 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5680
5681 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, &
5682 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5683 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5684 ! END: Right Monotonicity Preserving Bound
5685 end do
5686 end do
5687 end do
5688 end do
5689
5690# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5691#if defined(MFC_OpenACC)
5692# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5693!$acc end parallel loop
5694# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5695#elif defined(MFC_OpenMP)
5696# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5697
5698# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5699!$omp end target teams loop
5700# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5701#endif
5702 end if
5703# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5704# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5705# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5706 if (weno_dir == 3) then
5707
5708# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5709
5710# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5711#if defined(MFC_OpenACC)
5712# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5713!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5714# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5715#elif defined(MFC_OpenMP)
5716# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5717
5718# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5719
5720# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5721
5722# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5723!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5724# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5725!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5726# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5727#endif
5728 do l = is1_weno%beg, is1_weno%end
5729 do k = is2_weno%beg, is2_weno%end
5730 do j = is3_weno%beg, is3_weno%end
5731 do i = 1, v_size
5732 ! Second-order undivided differences for curvature estimation
5733
5734 vp0 = v_rs_ws(j, k, l, i)
5735 vm1 = v_rs_ws(j, k, l - 1, i)
5736 vm2 = v_rs_ws(j, k, l - 2, i)
5737 vp1 = v_rs_ws(j, k, l + 1, i)
5738 vp2 = v_rs_ws(j, k, l + 2, i)
5739
5740 d(-1) = vp0 + vm2 - vm1*2._wp
5741 d(0) = vp1 + vm1 - vp0*2._wp
5742 d(1) = vp2 + vp0 - vp1*2._wp
5743
5744 ! Median function for oscillation detection
5745 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5746 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5747 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5748 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5749
5750 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5751 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5752 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5753
5754 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5755
5756 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5757
5758 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5759
5760 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5761
5762 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5763
5764 vl_rs_vf(j, k, l, i) = vl_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vl_min - vl_rs_vf(j, k, l, &
5765 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5766 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5767 ! END: Left Monotonicity Preserving Bound
5768
5769 ! Right Monotonicity Preserving Bound
5770 d(-1) = vp0 + vm2 - vm1*2._wp
5771 d(0) = vp1 + vm1 - vp0*2._wp
5772 d(1) = vp2 + vp0 - vp1*2._wp
5773
5774 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5775 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5776 & d(1))))*min(abs(4._wp*d(0) - d(1)), abs(d(0)), abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp
5777
5778 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5779 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5780 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5781 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5782
5783 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5784
5785 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5786
5787 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5788
5789 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5790
5791 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5792
5793 vr_rs_vf(j, k, l, i) = vr_rs_vf(j, k, l, i) + (sign(5.e-1_wp, vr_min - vr_rs_vf(j, k, l, &
5794 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5795 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5796 ! END: Right Monotonicity Preserving Bound
5797 end do
5798 end do
5799 end do
5800 end do
5801
5802# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5803#if defined(MFC_OpenACC)
5804# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5805!$acc end parallel loop
5806# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5807#elif defined(MFC_OpenMP)
5808# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5809
5810# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5811!$omp end target teams loop
5812# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5813#endif
5814 end if
5815# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5816
5817 end subroutine s_preserve_monotonicity
5818
5819 !> Module deallocation and/or disassociation procedures
5820 impure subroutine s_finalize_weno_module()
5821
5822 if (weno_order == 1) return
5823
5824 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5825
5826#ifdef MFC_DEBUG
5827# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5828 block
5829# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5830 use iso_fortran_env, only: output_unit
5831# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5832
5833# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5834 print *, 'm_weno.fpp:1608: ', '@:DEALLOCATE(v_rs_weno)'
5835# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5836
5837# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5838 call flush (output_unit)
5839# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5840 end block
5841# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5842#endif
5843# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844
5845# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5846#if defined(MFC_OpenACC)
5847# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5848!$acc exit data delete(v_rs_weno)
5849# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5850#elif defined(MFC_OpenMP)
5851# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5852!$omp target exit data map(release:v_rs_weno)
5853# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5854#endif
5855# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5856 deallocate (v_rs_weno)
5857
5858 ! Deallocating WENO coefficients in x-direction
5859#ifdef MFC_DEBUG
5860# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5861 block
5862# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5863 use iso_fortran_env, only: output_unit
5864# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5865
5866# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5867 print *, 'm_weno.fpp:1611: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5868# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5869
5870# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5871 call flush (output_unit)
5872# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5873 end block
5874# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5875#endif
5876# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5877
5878# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879#if defined(MFC_OpenACC)
5880# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5881!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5882# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5883#elif defined(MFC_OpenMP)
5884# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5885!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5886# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5887#endif
5888# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5889 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5890#ifdef MFC_DEBUG
5891# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5892 block
5893# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5894 use iso_fortran_env, only: output_unit
5895# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5896
5897# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5898 print *, 'm_weno.fpp:1612: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5899# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5900
5901# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5902 call flush (output_unit)
5903# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5904 end block
5905# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5906#endif
5907# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5908
5909# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5910#if defined(MFC_OpenACC)
5911# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5912!$acc exit data delete(d_cbL_x, d_cbR_x)
5913# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5914#elif defined(MFC_OpenMP)
5915# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5916!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5917# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5918#endif
5919# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5920 deallocate (d_cbl_x, d_cbr_x)
5921#ifdef MFC_DEBUG
5922# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5923 block
5924# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5925 use iso_fortran_env, only: output_unit
5926# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5927
5928# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5929 print *, 'm_weno.fpp:1613: ', '@:DEALLOCATE(beta_coef_x)'
5930# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5931
5932# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5933 call flush (output_unit)
5934# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5935 end block
5936# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5937#endif
5938# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5939
5940# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5941#if defined(MFC_OpenACC)
5942# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5943!$acc exit data delete(beta_coef_x)
5944# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5945#elif defined(MFC_OpenMP)
5946# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5947!$omp target exit data map(release:beta_coef_x)
5948# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5949#endif
5950# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5951 deallocate (beta_coef_x)
5952
5953 ! Deallocating WENO coefficients in y-direction
5954 if (n == 0) return
5955
5956#ifdef MFC_DEBUG
5957# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5958 block
5959# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5960 use iso_fortran_env, only: output_unit
5961# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5962
5963# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5964 print *, 'm_weno.fpp:1618: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5965# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5966
5967# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5968 call flush (output_unit)
5969# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5970 end block
5971# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5972#endif
5973# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5974
5975# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5976#if defined(MFC_OpenACC)
5977# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5978!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5979# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5980#elif defined(MFC_OpenMP)
5981# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5982!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5983# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5984#endif
5985# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5986 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5987#ifdef MFC_DEBUG
5988# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5989 block
5990# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5991 use iso_fortran_env, only: output_unit
5992# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5993
5994# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5995 print *, 'm_weno.fpp:1619: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5996# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5997
5998# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5999 call flush (output_unit)
6000# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6001 end block
6002# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6003#endif
6004# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6005
6006# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6007#if defined(MFC_OpenACC)
6008# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6009!$acc exit data delete(d_cbL_y, d_cbR_y)
6010# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6011#elif defined(MFC_OpenMP)
6012# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6013!$omp target exit data map(release:d_cbL_y, d_cbR_y)
6014# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6015#endif
6016# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6017 deallocate (d_cbl_y, d_cbr_y)
6018#ifdef MFC_DEBUG
6019# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6020 block
6021# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6022 use iso_fortran_env, only: output_unit
6023# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6024
6025# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6026 print *, 'm_weno.fpp:1620: ', '@:DEALLOCATE(beta_coef_y)'
6027# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6028
6029# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6030 call flush (output_unit)
6031# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6032 end block
6033# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6034#endif
6035# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6036
6037# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6038#if defined(MFC_OpenACC)
6039# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6040!$acc exit data delete(beta_coef_y)
6041# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6042#elif defined(MFC_OpenMP)
6043# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6044!$omp target exit data map(release:beta_coef_y)
6045# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6046#endif
6047# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6048 deallocate (beta_coef_y)
6049
6050 ! Deallocating WENO coefficients in z-direction
6051 if (p == 0) return
6052
6053#ifdef MFC_DEBUG
6054# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6055 block
6056# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6057 use iso_fortran_env, only: output_unit
6058# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6059
6060# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6061 print *, 'm_weno.fpp:1625: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
6062# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6063
6064# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6065 call flush (output_unit)
6066# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6067 end block
6068# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6069#endif
6070# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6071
6072# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6073#if defined(MFC_OpenACC)
6074# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6075!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
6076# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6077#elif defined(MFC_OpenMP)
6078# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6079!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
6080# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6081#endif
6082# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6083 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
6084#ifdef MFC_DEBUG
6085# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6086 block
6087# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6088 use iso_fortran_env, only: output_unit
6089# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6090
6091# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6092 print *, 'm_weno.fpp:1626: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
6093# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6094
6095# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6096 call flush (output_unit)
6097# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6098 end block
6099# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6100#endif
6101# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6102
6103# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6104#if defined(MFC_OpenACC)
6105# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6106!$acc exit data delete(d_cbL_z, d_cbR_z)
6107# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6108#elif defined(MFC_OpenMP)
6109# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6110!$omp target exit data map(release:d_cbL_z, d_cbR_z)
6111# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6112#endif
6113# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6114 deallocate (d_cbl_z, d_cbr_z)
6115#ifdef MFC_DEBUG
6116# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6117 block
6118# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6119 use iso_fortran_env, only: output_unit
6120# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6121
6122# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6123 print *, 'm_weno.fpp:1627: ', '@:DEALLOCATE(beta_coef_z)'
6124# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6125
6126# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6127 call flush (output_unit)
6128# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6129 end block
6130# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6131#endif
6132# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6133
6134# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6135#if defined(MFC_OpenACC)
6136# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6137!$acc exit data delete(beta_coef_z)
6138# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6139#elif defined(MFC_OpenMP)
6140# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6141!$omp target exit data map(release:beta_coef_z)
6142# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6143#endif
6144# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6145 deallocate (beta_coef_z)
6146
6147 end subroutine s_finalize_weno_module
6148
6149end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:995
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:995
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:995
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:334
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:760
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:334
m_nvtx
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
m_thinc
THINC and MTHINC interface compression for volume fraction sharpening. THINC (int_comp=1): 1D directi...
Definition m_thinc.fpp.f90:329
m_thinc::s_thinc_compression
subroutine, public s_thinc_compression(v_rs_ws, vl_rs_vf_x, vr_rs_vf_x, recon_dir, is1_d, is2_d, is3_d)
Applies THINC (int_comp=1) or MTHINC (int_comp=2) interface compression to sharpen volume-fraction an...
Definition m_thinc.fpp.f90:841
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:333
m_weno::s_preserve_monotonicity
subroutine s_preserve_monotonicity(v_rs_ws, vl_rs_vf, vr_rs_vf, weno_dir)
Enforce monotonicity-preserving bounds on the WENO reconstruction.
Definition m_weno.fpp.f90:5459
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:470
m_weno::d_cbl_z
real(wp), dimension(:,:), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:403
m_weno::poly_coef_cbl_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:367
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Definition m_weno.fpp.f90:491
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:470
m_weno::d_cbl_y
real(wp), dimension(:,:), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:402
m_weno::beta_coef_y
real(wp), dimension(:,:,:), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:425
m_weno::s_pack_weno_input_arr
subroutine, public s_pack_weno_input_arr(v_vf)
Definition m_weno.fpp.f90:3189
m_weno::d_cbr_y
real(wp), dimension(:,:), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:405
m_weno::beta_coef_x
real(wp), dimension(:,:,:), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:424
m_weno::beta_coef_z
real(wp), dimension(:,:,:), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:426
m_weno::d_cbr_x
real(wp), dimension(:,:), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:404
m_weno::d_cbr_z
real(wp), dimension(:,:), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:406
m_weno::uniform_grid
logical, dimension(3) uniform_grid
True if grid spacing is uniform in each direction.
Definition m_weno.fpp.f90:455
m_weno::poly_coef_cbl_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:369
m_weno::poly_coef_cbr_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:370
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:442
m_weno::d_cbl_x
real(wp), dimension(:,:), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:401
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:470
m_weno::poly_coef_cbr_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:371
m_weno::v_rs_weno
real(wp), dimension(:,:,:,:), allocatable v_rs_weno
Definition m_weno.fpp.f90:346
m_weno::s_weno
subroutine, public s_weno(v_vf, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables.
Definition m_weno.fpp.f90:3239
m_weno::poly_coef_cbl_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:368
m_weno::s_compute_weno_coefficients
subroutine s_compute_weno_coefficients(weno_dir, is)
Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction.
Definition m_weno.fpp.f90:1086
m_weno::poly_coef_cbr_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:372
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5821
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:417