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# 145 "/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# 145 "/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# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 377 "/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# 145 "/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# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Allocate and create GPU device memory
312# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Free GPU device memory and deallocate
315# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for vector fields
318# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320! Cray-specific GPU pointer setup for scalar fields
321# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323! Cray-specific GPU pointer setup for acoustic source spatials
324# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325
326# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 163 "/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_GPU_MODULE()
339
340 use m_mpi_proxy
341 use m_thinc, only: s_thinc_compression
342 use m_nvtx
343
344 private; public :: s_initialize_weno_module, s_finalize_weno_module, s_weno, s_pack_weno_input_arr
345
346 !> @name The cell-average variables that will be WENO-reconstructed unpacked into an array for performance
347 !> @{
348 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_weno
349 !> @}
350
351# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
352#if defined(MFC_OpenACC)
353# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
354!$acc declare create(v_rs_weno)
355# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
356#elif defined(MFC_OpenMP)
357# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
358!$omp declare target (v_rs_weno)
359# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
360#endif
361
362 ! WENO Coefficients
363
364 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at the left and right quadrature points (QP), in
365 !! the x-, y- and z-directions. Note that the first dimension of the array identifies the polynomial, the second dimension
366 !! identifies the position of its coefficients and the last dimension denotes the cell-location in the relevant coordinate
367 !! direction.
368 !> @{
369 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_x
370 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_y
371 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_z
372 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_x
373 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_y
374 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_z
375 !> @}
376
377# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
378#if defined(MFC_OpenACC)
379# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
380!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
381# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
382#elif defined(MFC_OpenMP)
383# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
384!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
385# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
386#endif
387
388# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
389#if defined(MFC_OpenACC)
390# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
391!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
392# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
393#elif defined(MFC_OpenMP)
394# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
395!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
396# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
397#endif
398
399 !> @name The ideal weights at the left and the right cell-boundaries and at the left and the right quadrature points, in x-, y-
400 !! and z-directions. Note that the first dimension of the array identifies the weight, while the last denotes the cell-location
401 !! in the relevant coordinate direction.
402 !> @{
403 real(wp), target, allocatable, dimension(:,:) :: d_cbl_x
404 real(wp), target, allocatable, dimension(:,:) :: d_cbl_y
405 real(wp), target, allocatable, dimension(:,:) :: d_cbl_z
406 real(wp), target, allocatable, dimension(:,:) :: d_cbr_x
407 real(wp), target, allocatable, dimension(:,:) :: d_cbr_y
408 real(wp), target, allocatable, dimension(:,:) :: d_cbr_z
409 !> @}
410
411# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
412#if defined(MFC_OpenACC)
413# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
414!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
415# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
416#elif defined(MFC_OpenMP)
417# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
418!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
419# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
420#endif
421
422 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note that the first array dimension identifies the
423 !! smoothness indicator, the second identifies the position of its coefficients and the last denotes the cell-location in the
424 !! relevant coordinate direction.
425 !> @{
426 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_x
427 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_y
428 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_z
429 !> @}
430
431# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
432#if defined(MFC_OpenACC)
433# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
434!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
435# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
436#elif defined(MFC_OpenMP)
437# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
438!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
439# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
440#endif
441
442 ! END: WENO Coefficients
443
444 integer :: v_size !< Number of WENO-reconstructed cell-average variables
445
446# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447#if defined(MFC_OpenACC)
448# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449!$acc declare create(v_size)
450# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
451#elif defined(MFC_OpenMP)
452# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
453!$omp declare target (v_size)
454# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
455#endif
456
457 logical :: uniform_grid(3) !< True if grid spacing is uniform in each direction
458
459# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
460#if defined(MFC_OpenACC)
461# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
462!$acc declare create(uniform_grid)
463# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
464#elif defined(MFC_OpenMP)
465# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
466!$omp declare target (uniform_grid)
467# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
468#endif
469
470 !> @name Indical bounds in the s1-, s2- and s3-directions
471 !> @{
472 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
473#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
474
475# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
476#if defined(MFC_OpenACC)
477# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
478!$acc declare create(is1_weno, is2_weno, is3_weno)
479# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
480#elif defined(MFC_OpenMP)
481# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
482!$omp declare target (is1_weno, is2_weno, is3_weno)
483# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
484#endif
485#endif
486 !
487 !> @}
488
489contains
490
491 !> Initialize the WENO module
492 impure subroutine s_initialize_weno_module
493
494 if (weno_order == 1) return
495
496 ! Allocating/Computing WENO Coefficients in x-direction
497 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
498 if (n == 0) then
499 is2_weno%beg = 0
500 else
501 is2_weno%beg = -buff_size
502 end if
503
504 is2_weno%end = n - is2_weno%beg
505
506 if (p == 0) then
507 is3_weno%beg = 0
508 else
509 is3_weno%beg = -buff_size
510 end if
511
512 is3_weno%end = p - is3_weno%beg
513
514#ifdef MFC_DEBUG
515# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
516 block
517# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
518 use iso_fortran_env, only: output_unit
519# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
520
521# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
522 print *, 'm_weno.fpp:109: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
523# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
524
525# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
526 call flush (output_unit)
527# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
528 end block
529# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
530#endif
531# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
532 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
533# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
534
535# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
536
537# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
538#if defined(MFC_OpenACC)
539# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
540!$acc enter data create(poly_coef_cbL_x)
541# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
542#elif defined(MFC_OpenMP)
543# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
544!$omp target enter data map(always,alloc:poly_coef_cbL_x)
545# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
546#endif
547#ifdef MFC_DEBUG
548# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
549 block
550# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
551 use iso_fortran_env, only: output_unit
552# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
553
554# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
555 print *, 'm_weno.fpp:110: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
556# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
557
558# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
559 call flush (output_unit)
560# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
561 end block
562# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
563#endif
564# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
565 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
566# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
567
568# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
569
570# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
571#if defined(MFC_OpenACC)
572# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
573!$acc enter data create(poly_coef_cbR_x)
574# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
575#elif defined(MFC_OpenMP)
576# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
577!$omp target enter data map(always,alloc:poly_coef_cbR_x)
578# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
579#endif
580
581#ifdef MFC_DEBUG
582# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
583 block
584# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
585 use iso_fortran_env, only: output_unit
586# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
587
588# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
589 print *, 'm_weno.fpp:112: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
590# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
591
592# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593 call flush (output_unit)
594# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595 end block
596# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597#endif
598# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
600# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601
602# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603
604# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605#if defined(MFC_OpenACC)
606# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607!$acc enter data create(d_cbL_x)
608# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
609#elif defined(MFC_OpenMP)
610# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
611!$omp target enter data map(always,alloc:d_cbL_x)
612# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
613#endif
614#ifdef MFC_DEBUG
615# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
616 block
617# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
618 use iso_fortran_env, only: output_unit
619# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
620
621# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
622 print *, 'm_weno.fpp:113: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
623# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
624
625# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
626 call flush (output_unit)
627# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
628 end block
629# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
630#endif
631# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
632 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
633# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
634
635# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
636
637# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
638#if defined(MFC_OpenACC)
639# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
640!$acc enter data create(d_cbR_x)
641# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
642#elif defined(MFC_OpenMP)
643# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
644!$omp target enter data map(always,alloc:d_cbR_x)
645# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
646#endif
647
648#ifdef MFC_DEBUG
649# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
650 block
651# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
652 use iso_fortran_env, only: output_unit
653# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
654
655# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
656 print *, 'm_weno.fpp:115: ', '@: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))'
657# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
658
659# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
660 call flush (output_unit)
661# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
662 end block
663# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664#endif
665# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666 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))
667# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668
669# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670
671# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672#if defined(MFC_OpenACC)
673# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674!$acc enter data create(beta_coef_x)
675# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676#elif defined(MFC_OpenMP)
677# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678!$omp target enter data map(always,alloc:beta_coef_x)
679# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680#endif
681# 117 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
682 ! 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
683 ! differences (dvd) not the values themselves
684
685 call s_compute_weno_coefficients(1, is1_weno)
686
687#ifdef MFC_DEBUG
688# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
689 block
690# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
691 use iso_fortran_env, only: output_unit
692# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
693
694# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
695 print *, 'm_weno.fpp:122: ', '@: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))'
696# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
697
698# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
699 call flush (output_unit)
700# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
701 end block
702# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
703#endif
704# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
705 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))
706# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
707
708# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
709
710# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
711#if defined(MFC_OpenACC)
712# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713!$acc enter data create(v_rs_weno)
714# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
715#elif defined(MFC_OpenMP)
716# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
717!$omp target enter data map(always,alloc:v_rs_weno)
718# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
719#endif
720
721 ! Allocating/Computing WENO Coefficients in y-direction
722 if (n == 0) return
723
724 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
725 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
726
727 if (p == 0) then
728 is3_weno%beg = 0
729 else
730 is3_weno%beg = -buff_size
731 end if
732
733 is3_weno%end = p - is3_weno%beg
734
735#ifdef MFC_DEBUG
736# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
737 block
738# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
739 use iso_fortran_env, only: output_unit
740# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
741
742# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
743 print *, 'm_weno.fpp:138: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
744# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
745
746# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 call flush (output_unit)
748# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749 end block
750# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751#endif
752# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
754# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755
756# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757
758# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759#if defined(MFC_OpenACC)
760# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761!$acc enter data create(poly_coef_cbL_y)
762# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763#elif defined(MFC_OpenMP)
764# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
765!$omp target enter data map(always,alloc:poly_coef_cbL_y)
766# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
767#endif
768#ifdef MFC_DEBUG
769# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
770 block
771# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
772 use iso_fortran_env, only: output_unit
773# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
774
775# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
776 print *, 'm_weno.fpp:139: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
777# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
778
779# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
780 call flush (output_unit)
781# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782 end block
783# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784#endif
785# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
787# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788
789# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790
791# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792#if defined(MFC_OpenACC)
793# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794!$acc enter data create(poly_coef_cbR_y)
795# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
796#elif defined(MFC_OpenMP)
797# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798!$omp target enter data map(always,alloc:poly_coef_cbR_y)
799# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
800#endif
801
802#ifdef MFC_DEBUG
803# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804 block
805# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806 use iso_fortran_env, only: output_unit
807# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808
809# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810 print *, 'm_weno.fpp:141: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
811# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
812
813# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
814 call flush (output_unit)
815# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
816 end block
817# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
818#endif
819# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
820 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
821# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
822
823# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
824
825# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
826#if defined(MFC_OpenACC)
827# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
828!$acc enter data create(d_cbL_y)
829# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
830#elif defined(MFC_OpenMP)
831# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
832!$omp target enter data map(always,alloc:d_cbL_y)
833# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
834#endif
835#ifdef MFC_DEBUG
836# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
837 block
838# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
839 use iso_fortran_env, only: output_unit
840# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
841
842# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
843 print *, 'm_weno.fpp:142: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
844# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
845
846# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
847 call flush (output_unit)
848# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849 end block
850# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851#endif
852# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
854# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855
856# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857
858# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859#if defined(MFC_OpenACC)
860# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861!$acc enter data create(d_cbR_y)
862# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
863#elif defined(MFC_OpenMP)
864# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865!$omp target enter data map(always,alloc:d_cbR_y)
866# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
867#endif
868
869#ifdef MFC_DEBUG
870# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871 block
872# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873 use iso_fortran_env, only: output_unit
874# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875
876# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877 print *, 'm_weno.fpp:144: ', '@: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))'
878# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
879
880# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
881 call flush (output_unit)
882# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
883 end block
884# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
885#endif
886# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
887 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))
888# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
889
890# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
891
892# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
893#if defined(MFC_OpenACC)
894# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
895!$acc enter data create(beta_coef_y)
896# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
897#elif defined(MFC_OpenMP)
898# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
899!$omp target enter data map(always,alloc:beta_coef_y)
900# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
901#endif
902# 146 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
903
904 call s_compute_weno_coefficients(2, is2_weno)
905
906 ! Allocating/Computing WENO Coefficients in z-direction
907 if (p == 0) return
908
909 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
910 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
911 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
912
913#ifdef MFC_DEBUG
914# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
915 block
916# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
917 use iso_fortran_env, only: output_unit
918# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
919
920# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
921 print *, 'm_weno.fpp:156: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
922# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
923
924# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
925 call flush (output_unit)
926# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
927 end block
928# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
929#endif
930# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
931 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
932# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
933
934# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
935
936# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
937#if defined(MFC_OpenACC)
938# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
939!$acc enter data create(poly_coef_cbL_z)
940# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
941#elif defined(MFC_OpenMP)
942# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
943!$omp target enter data map(always,alloc:poly_coef_cbL_z)
944# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
945#endif
946#ifdef MFC_DEBUG
947# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
948 block
949# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950 use iso_fortran_env, only: output_unit
951# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
952
953# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
954 print *, 'm_weno.fpp:157: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
955# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956
957# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958 call flush (output_unit)
959# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960 end block
961# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962#endif
963# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
965# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966
967# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968
969# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970#if defined(MFC_OpenACC)
971# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972!$acc enter data create(poly_coef_cbR_z)
973# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
974#elif defined(MFC_OpenMP)
975# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976!$omp target enter data map(always,alloc:poly_coef_cbR_z)
977# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
978#endif
979
980#ifdef MFC_DEBUG
981# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
982 block
983# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984 use iso_fortran_env, only: output_unit
985# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986
987# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988 print *, 'm_weno.fpp:159: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
989# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
990
991# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992 call flush (output_unit)
993# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
994 end block
995# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
996#endif
997# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
998 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
999# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1000
1001# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1002
1003# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1004#if defined(MFC_OpenACC)
1005# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1006!$acc enter data create(d_cbL_z)
1007# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1008#elif defined(MFC_OpenMP)
1009# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1010!$omp target enter data map(always,alloc:d_cbL_z)
1011# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1012#endif
1013#ifdef MFC_DEBUG
1014# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1015 block
1016# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1017 use iso_fortran_env, only: output_unit
1018# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1019
1020# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1021 print *, 'm_weno.fpp:160: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1022# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023
1024# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025 call flush (output_unit)
1026# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027 end block
1028# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1029#endif
1030# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1031 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1032# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1033
1034# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1035
1036# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1037#if defined(MFC_OpenACC)
1038# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1039!$acc enter data create(d_cbR_z)
1040# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1041#elif defined(MFC_OpenMP)
1042# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1043!$omp target enter data map(always,alloc:d_cbR_z)
1044# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1045#endif
1046
1047#ifdef MFC_DEBUG
1048# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1049 block
1050# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1051 use iso_fortran_env, only: output_unit
1052# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1053
1054# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1055 print *, 'm_weno.fpp:162: ', '@: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))'
1056# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1057
1058# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1059 call flush (output_unit)
1060# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1061 end block
1062# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1063#endif
1064# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1065 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))
1066# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1067
1068# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1069
1070# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1071#if defined(MFC_OpenACC)
1072# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1073!$acc enter data create(beta_coef_z)
1074# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1075#elif defined(MFC_OpenMP)
1076# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1077!$omp target enter data map(always,alloc:beta_coef_z)
1078# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1079#endif
1080# 164 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1081
1082 call s_compute_weno_coefficients(3, is3_weno)
1083
1084 end subroutine s_initialize_weno_module
1085
1086 !> Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction
1087 subroutine s_compute_weno_coefficients(weno_dir, is)
1088
1089 ! Compute WENO coefficients for a given coordinate direction. Shu (1997)
1090 integer, intent(in) :: weno_dir
1091 type(int_bounds_info), intent(in) :: is
1092 integer :: s
1093 real(wp), pointer, dimension(:) :: s_cb => null() !< Cell-boundary locations in the s-direction
1094 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1095 integer :: i !< Generic loop iterator
1096 real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil
1097 real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1098 real(wp) :: h0 !< Reference spacing for uniform-grid detection
1099
1100 ! Determine cell count, boundary locations, and BCs for selected WENO direction
1101
1102 if (weno_dir == 1) then
1103 s = m; s_cb => x_cb; bc_s = bc_x
1104 else if (weno_dir == 2) then
1105 s = n; s_cb => y_cb; bc_s = bc_y
1106 else
1107 s = p; s_cb => z_cb; bc_s = bc_z
1108 end if
1109
1110# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1111 ! Computing WENO3 Coefficients
1112 if (weno_dir == 1) then
1113 if (weno_order == 3) then
1114 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1115 ! Polynomial reconstruction coefficients
1116 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1117 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1118
1119 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1120 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1121
1122 ! Ideal (linear) weights
1123 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1124 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1125
1126 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1127 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1128
1129 ! Smoothness indicator coefficients
1130 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
1131 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
1132 end do
1133
1134 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1135 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1136 if (null_weights) then
1137 if (bc_s%beg == bc_riemann_extrap) then
1138 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1139 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1140 end if
1141
1142 if (bc_s%end == bc_riemann_extrap) then
1143 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1144 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1145 end if
1146 end if
1147 ! END: Computing WENO3 Coefficients
1148
1149 ! Computing WENO5 Coefficients
1150 else if (weno_order == 5) then
1151 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1152 ! Polynomial reconstruction coefficients
1153 poly_coef_cbr_x(i + 1, 0, &
1154 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1155 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1156 poly_coef_cbr_x(i + 1, 1, &
1157 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1158 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1159 poly_coef_cbr_x(i + 1, 1, &
1160 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1161 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1162 poly_coef_cbr_x(i + 1, 2, &
1163 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1164 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1165 poly_coef_cbl_x(i + 1, 0, &
1166 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1167 & *(s_cb(i + 3) - s_cb(i + 1)))
1168 poly_coef_cbl_x(i + 1, 1, &
1169 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1170 & + 2))*(s_cb(i) - s_cb(i + 2)))
1171 poly_coef_cbl_x(i + 1, 1, &
1172 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1173 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1174 poly_coef_cbl_x(i + 1, 2, &
1175 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1176 & *(s_cb(i - 2) - s_cb(i + 1)))
1177
1178 poly_coef_cbr_x(i + 1, 0, &
1179 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1180 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1181 poly_coef_cbr_x(i + 1, 2, &
1182 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1183 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1184 poly_coef_cbl_x(i + 1, 0, &
1185 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1186 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1187 poly_coef_cbl_x(i + 1, 2, &
1188 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1189 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1190
1191 ! Ideal (linear) weights
1192 d_cbr_x(0, &
1193 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1194 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1195 d_cbr_x(2, &
1196 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1197 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1198 d_cbl_x(0, &
1199 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1200 & *(s_cb(i + 3) - s_cb(i - 1)))
1201 d_cbl_x(2, &
1202 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1203 & *(s_cb(i - 2) - s_cb(i + 3)))
1204
1205 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1206 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1207
1208 ! Smoothness indicator coefficients
1209 beta_coef_x(i + 1, 0, &
1210 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1211 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1212 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1213
1214 beta_coef_x(i + 1, 0, &
1215 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1216 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1217 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1218 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1219
1220 beta_coef_x(i + 1, 0, &
1221 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1222 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1223 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1224 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1225
1226 beta_coef_x(i + 1, 1, &
1227 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1228 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1229 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1230
1231 beta_coef_x(i + 1, 1, &
1232 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1233 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1234 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1235 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1236
1237 beta_coef_x(i + 1, 1, &
1238 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1239 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1240 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1241
1242 beta_coef_x(i + 1, 2, &
1243 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1244 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1245 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1246 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1247
1248 beta_coef_x(i + 1, 2, &
1249 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1250 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1251 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1252 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1253
1254 beta_coef_x(i + 1, 2, &
1255 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1256 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1257 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1258 end do
1259
1260 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1261 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1262 if (null_weights) then
1263 if (bc_s%beg == bc_riemann_extrap) then
1264 d_cbr_x(1:2,0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1265 d_cbl_x(1:2,0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1266 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:,1) = d_cbr_x(:,1)/sum(d_cbr_x(:,1))
1267 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:,1) = d_cbl_x(:,1)/sum(d_cbl_x(:,1))
1268 end if
1269
1270 if (bc_s%end == bc_riemann_extrap) then
1271 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:,s - 1) = d_cbr_x(:, &
1272 & s - 1)/sum(d_cbr_x(:,s - 1))
1273 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:,s - 1) = d_cbl_x(:, &
1274 & s - 1)/sum(d_cbl_x(:,s - 1))
1275 d_cbr_x(0:1,s) = 0._wp; d_cbr_x(2, s) = 1._wp
1276 d_cbl_x(0:1,s) = 0._wp; d_cbl_x(2, s) = 1._wp
1277 end if
1278 end if
1279 else
1280 if (.not. teno) then
1281 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1282 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1283 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1284 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1285 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1286 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1287 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1288 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1289 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1290 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1291 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1292 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1293
1294 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1295 d_cbr_x(0, &
1296 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1297 & *(w(1) - w(8)))
1298 d_cbr_x(1, &
1299 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1300 & *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) &
1301 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1302 & *(w(2) - w(8)))
1303 d_cbr_x(2, &
1304 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1305 & *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) &
1306 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1307 & *(w(3) - w(8)))
1308 d_cbr_x(3, &
1309 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1310 & *(w(3) - w(8)))
1311
1312 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
1313 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
1314 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
1315 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
1316 w(1) = s_cb(i + 4) - s_cb(i)
1317 w(2) = s_cb(i + 3) - s_cb(i)
1318 w(3) = s_cb(i + 2) - s_cb(i)
1319 w(4) = s_cb(i + 1) - s_cb(i)
1320 w(5) = s_cb(i) - s_cb(i)
1321 w(6) = s_cb(i - 1) - s_cb(i)
1322 w(7) = s_cb(i - 2) - s_cb(i)
1323 w(8) = s_cb(i - 3) - s_cb(i)
1324 d_cbl_x(0, &
1325 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1326 & *(w(3) - w(8)))
1327 d_cbl_x(1, &
1328 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1329 & *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) &
1330 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1331 & *(w(3) - w(8)))
1332 d_cbl_x(2, &
1333 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1334 & *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) &
1335 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1336 & *(w(2) - w(8)))
1337 d_cbl_x(3, &
1338 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1339 & *(w(1) - w(8)))
1340 ! Note: Left has the reversed order of both points and coefficients compared to the right
1341
1342 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1343 poly_coef_cbr_x(i + 1, 0, &
1344 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1345 & + y(2) + y(3) + y(4)))
1346 poly_coef_cbr_x(i + 1, 0, &
1347 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1348 & + 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) &
1349 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1350 poly_coef_cbr_x(i + 1, 0, &
1351 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1352 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1353 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1354
1355 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1356 poly_coef_cbr_x(i + 1, 1, &
1357 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1358 & + y(2) + y(3) + y(4)))
1359 poly_coef_cbr_x(i + 1, 1, &
1360 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1361 & + 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) &
1362 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1363 poly_coef_cbr_x(i + 1, 1, &
1364 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1365 & + y(2) + y(3) + y(4)))
1366
1367 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1368 poly_coef_cbr_x(i + 1, 2, &
1369 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1370 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1371 poly_coef_cbr_x(i + 1, 2, &
1372 & 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 &
1373 & + 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) &
1374 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1375 poly_coef_cbr_x(i + 1, 2, &
1376 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1377 & + y(2) + y(3) + y(4)))
1378
1379 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1380 poly_coef_cbr_x(i + 1, 3, &
1381 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1382 & + 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) &
1383 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1384 poly_coef_cbr_x(i + 1, 3, &
1385 & 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) &
1386 & + 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)) &
1387 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1388 & + y(4)))
1389 poly_coef_cbr_x(i + 1, 3, &
1390 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1391 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1392
1393 ! Element-wise: see the no-reversed-sections note above.
1394 y(1) = s_cb(i + 1) - s_cb(i)
1395 y(2) = s_cb(i) - s_cb(i - 1)
1396 y(3) = s_cb(i - 1) - s_cb(i - 2)
1397 y(4) = s_cb(i - 2) - s_cb(i - 3)
1398 poly_coef_cbl_x(i + 1, 3, &
1399 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1400 & + y(2) + y(3) + y(4)))
1401 poly_coef_cbl_x(i + 1, 3, &
1402 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1403 & + 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) &
1404 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1405 poly_coef_cbl_x(i + 1, 3, &
1406 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1407 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1408 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1409
1410 ! Element-wise: see the no-reversed-sections note above.
1411 y(1) = s_cb(i + 2) - s_cb(i + 1)
1412 y(2) = s_cb(i + 1) - s_cb(i)
1413 y(3) = s_cb(i) - s_cb(i - 1)
1414 y(4) = s_cb(i - 1) - s_cb(i - 2)
1415 poly_coef_cbl_x(i + 1, 2, &
1416 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1417 & + y(2) + y(3) + y(4)))
1418 poly_coef_cbl_x(i + 1, 2, &
1419 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1420 & + 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) &
1421 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1422 poly_coef_cbl_x(i + 1, 2, &
1423 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1424 & + y(2) + y(3) + y(4)))
1425
1426 ! Element-wise: see the no-reversed-sections note above.
1427 y(1) = s_cb(i + 3) - s_cb(i + 2)
1428 y(2) = s_cb(i + 2) - s_cb(i + 1)
1429 y(3) = s_cb(i + 1) - s_cb(i)
1430 y(4) = s_cb(i) - s_cb(i - 1)
1431 poly_coef_cbl_x(i + 1, 1, &
1432 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1433 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1434 poly_coef_cbl_x(i + 1, 1, &
1435 & 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 &
1436 & + 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) &
1437 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1438 poly_coef_cbl_x(i + 1, 1, &
1439 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1440 & + y(2) + y(3) + y(4)))
1441
1442 ! Element-wise: see the no-reversed-sections note above.
1443 y(1) = s_cb(i + 4) - s_cb(i + 3)
1444 y(2) = s_cb(i + 3) - s_cb(i + 2)
1445 y(3) = s_cb(i + 2) - s_cb(i + 1)
1446 y(4) = s_cb(i + 1) - s_cb(i)
1447 poly_coef_cbl_x(i + 1, 0, &
1448 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1449 & + 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) &
1450 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1451 poly_coef_cbl_x(i + 1, 0, &
1452 & 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) &
1453 & + 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)) &
1454 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1455 & + y(4)))
1456 poly_coef_cbl_x(i + 1, 0, &
1457 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1458 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1459
1460 poly_coef_cbl_x(i + 1,:,:) = -poly_coef_cbl_x(i + 1,:,:)
1461 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1462
1463 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1464 beta_coef_x(i + 1, 3, &
1465 & 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) &
1466 & + 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) &
1467 & **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 &
1468 & + 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) &
1469 & *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) &
1470 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
1471 & + 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) &
1472 & *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) &
1473 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
1474 & **2*(y(1) + y(2) + y(3) + y(4))**2)
1475 beta_coef_x(i + 1, 3, &
1476 & 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) &
1477 & **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) &
1478 & + 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) &
1479 & + 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) &
1480 & + 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) &
1481 & *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) &
1482 & *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) &
1483 & *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) &
1484 & **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) &
1485 & **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) &
1486 & *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) &
1487 & + 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) &
1488 & *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) &
1489 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
1490 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
1491 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1492 beta_coef_x(i + 1, 3, &
1493 & 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) &
1494 & **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) &
1495 & + 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) &
1496 & *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 &
1497 & + 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) &
1498 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
1499 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1500 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1501 beta_coef_x(i + 1, 3, &
1502 & 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 &
1503 & + 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 &
1504 & + 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 &
1505 & + 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) &
1506 & + 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) &
1507 & **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) &
1508 & **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) &
1509 & **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) &
1510 & **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) &
1511 & *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) &
1512 & **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) &
1513 & **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) &
1514 & **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) &
1515 & **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) &
1516 & **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) &
1517 & **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) &
1518 & **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) &
1519 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
1520 & + 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 &
1521 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
1522 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
1523 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1524 & + y(3) + y(4))**2)
1525 beta_coef_x(i + 1, 3, &
1526 & 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) &
1527 & **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) &
1528 & **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) &
1529 & **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) &
1530 & *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) &
1531 & *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) &
1532 & **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) &
1533 & **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) &
1534 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
1535 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
1536 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
1537 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1538 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1539 beta_coef_x(i + 1, 3, &
1540 & 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 &
1541 & + 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) &
1542 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
1543 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
1544 & + y(4))**2)
1545
1546 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1547 beta_coef_x(i + 1, 2, &
1548 & 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 &
1549 & + 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) &
1550 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
1551 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
1552 & + y(4))**2)
1553 beta_coef_x(i + 1, 2, &
1554 & 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 &
1555 & + 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) &
1556 & - 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 &
1557 & - 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 &
1558 & + 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 &
1559 & + 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 &
1560 & + 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 &
1561 & + 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) &
1562 & **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 &
1563 & - 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 &
1564 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
1565 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
1566 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
1567 & **2)
1568 beta_coef_x(i + 1, 2, &
1569 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
1570 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
1571 & + 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) &
1572 & *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)) &
1573 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1574 & + y(4))**2)
1575 beta_coef_x(i + 1, 2, &
1576 & 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 &
1577 & + 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 &
1578 & + 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 &
1579 & + 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) &
1580 & + 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) &
1581 & **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) &
1582 & **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) &
1583 & **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) &
1584 & **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) &
1585 & *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 &
1586 & + 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) &
1587 & **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 &
1588 & + 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 &
1589 & + 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) &
1590 & **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) &
1591 & *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) &
1592 & + 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 &
1593 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
1594 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
1595 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
1596 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1597 & + y(3) + y(4))**2)
1598 beta_coef_x(i + 1, 2, &
1599 & 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) &
1600 & **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) &
1601 & *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) &
1602 & *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) &
1603 & *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) &
1604 & **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) &
1605 & **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) &
1606 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
1607 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
1608 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
1609 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
1610 & **2)
1611 beta_coef_x(i + 1, 2, &
1612 & 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 &
1613 & - 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)) &
1614 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
1615
1616 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1617 beta_coef_x(i + 1, 1, &
1618 & 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 &
1619 & - 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)) &
1620 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1621 beta_coef_x(i + 1, 1, &
1622 & 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) &
1623 & *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) &
1624 & **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) &
1625 & **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) &
1626 & **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) &
1627 & **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) &
1628 & **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) &
1629 & *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) &
1630 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
1631 & **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) &
1632 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1633 & + y(3) + y(4))**2)
1634 beta_coef_x(i + 1, 1, &
1635 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
1636 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
1637 & + 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) &
1638 & *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)) &
1639 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1640 & + y(4))**2)
1641 beta_coef_x(i + 1, 1, &
1642 & 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) &
1643 & + 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) &
1644 & **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) &
1645 & **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) &
1646 & **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) &
1647 & **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) &
1648 & + 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) &
1649 & **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) &
1650 & **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) &
1651 & **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) &
1652 & **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) &
1653 & - 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) &
1654 & **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) &
1655 & **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) &
1656 & *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) &
1657 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
1658 & **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) &
1659 & **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) &
1660 & **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) &
1661 & **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) &
1662 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1663 beta_coef_x(i + 1, 1, &
1664 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
1665 & **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) &
1666 & **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) &
1667 & *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) &
1668 & + 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) &
1669 & **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) &
1670 & **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) &
1671 & **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) &
1672 & **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 &
1673 & - 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 &
1674 & - 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) &
1675 & **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) &
1676 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1677 beta_coef_x(i + 1, 1, &
1678 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
1679 & **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 &
1680 & + 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) &
1681 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1682 & + y(3) + y(4))**2)
1683
1684 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1685 beta_coef_x(i + 1, 0, &
1686 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
1687 & **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 &
1688 & + 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) &
1689 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1690 & + y(3) + y(4))**2)
1691 beta_coef_x(i + 1, 0, &
1692 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
1693 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
1694 & **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) &
1695 & **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) &
1696 & + 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) &
1697 & **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 &
1698 & + 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) &
1699 & **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) &
1700 & *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 &
1701 & + 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) &
1702 & + 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) &
1703 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1704 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1705 beta_coef_x(i + 1, 0, &
1706 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
1707 & *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) &
1708 & + 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) &
1709 & **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) &
1710 & + 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) &
1711 & *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) &
1712 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
1713 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1714 beta_coef_x(i + 1, 0, &
1715 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
1716 & **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) &
1717 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
1718 & + 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) &
1719 & + 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) &
1720 & *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) &
1721 & *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) &
1722 & + 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) &
1723 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
1724 & + 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) &
1725 & **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) &
1726 & **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) &
1727 & *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) &
1728 & **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) &
1729 & **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 &
1730 & + 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) &
1731 & + 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 &
1732 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
1733 & + 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) &
1734 & **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) &
1735 & **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) &
1736 & **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)) &
1737 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1738 beta_coef_x(i + 1, 0, &
1739 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
1740 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
1741 & **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) &
1742 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
1743 & **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) &
1744 & **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) &
1745 & **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) &
1746 & + 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) &
1747 & + 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) &
1748 & + 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) &
1749 & *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 &
1750 & + 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) &
1751 & *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) &
1752 & + 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) &
1753 & **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)) &
1754 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1755 & + y(4))**2)
1756 beta_coef_x(i + 1, 0, &
1757 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
1758 & **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) &
1759 & + 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) &
1760 & *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 &
1761 & + 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) &
1762 & **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) &
1763 & + 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) &
1764 & **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) &
1765 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1766 & + y(3) + y(4))**2)
1767 end do
1768 else
1769 ! (Fu, et al., 2016) Table 2 (for right flux)
1770 d_cbl_x(0,:) = 18._wp/35._wp
1771 d_cbl_x(1,:) = 3._wp/35._wp
1772 d_cbl_x(2,:) = 9._wp/35._wp
1773 d_cbl_x(3,:) = 1._wp/35._wp
1774 d_cbl_x(4,:) = 4._wp/35._wp
1775
1776 d_cbr_x(0,:) = 18._wp/35._wp
1777 d_cbr_x(1,:) = 9._wp/35._wp
1778 d_cbr_x(2,:) = 3._wp/35._wp
1779 d_cbr_x(3,:) = 4._wp/35._wp
1780 d_cbr_x(4,:) = 1._wp/35._wp
1781 end if
1782 end if
1783 end if
1784# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1785 ! Computing WENO3 Coefficients
1786 if (weno_dir == 2) then
1787 if (weno_order == 3) then
1788 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1789 ! Polynomial reconstruction coefficients
1790 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1791 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1792
1793 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1794 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1795
1796 ! Ideal (linear) weights
1797 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1798 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1799
1800 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1801 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1802
1803 ! Smoothness indicator coefficients
1804 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
1805 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
1806 end do
1807
1808 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1809 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1810 if (null_weights) then
1811 if (bc_s%beg == bc_riemann_extrap) then
1812 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1813 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1814 end if
1815
1816 if (bc_s%end == bc_riemann_extrap) then
1817 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1818 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1819 end if
1820 end if
1821 ! END: Computing WENO3 Coefficients
1822
1823 ! Computing WENO5 Coefficients
1824 else if (weno_order == 5) then
1825 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1826 ! Polynomial reconstruction coefficients
1827 poly_coef_cbr_y(i + 1, 0, &
1828 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1829 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1830 poly_coef_cbr_y(i + 1, 1, &
1831 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1832 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1833 poly_coef_cbr_y(i + 1, 1, &
1834 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1835 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1836 poly_coef_cbr_y(i + 1, 2, &
1837 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1838 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1839 poly_coef_cbl_y(i + 1, 0, &
1840 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1841 & *(s_cb(i + 3) - s_cb(i + 1)))
1842 poly_coef_cbl_y(i + 1, 1, &
1843 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1844 & + 2))*(s_cb(i) - s_cb(i + 2)))
1845 poly_coef_cbl_y(i + 1, 1, &
1846 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1847 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1848 poly_coef_cbl_y(i + 1, 2, &
1849 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1850 & *(s_cb(i - 2) - s_cb(i + 1)))
1851
1852 poly_coef_cbr_y(i + 1, 0, &
1853 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1854 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1855 poly_coef_cbr_y(i + 1, 2, &
1856 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1857 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1858 poly_coef_cbl_y(i + 1, 0, &
1859 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1860 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1861 poly_coef_cbl_y(i + 1, 2, &
1862 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1863 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1864
1865 ! Ideal (linear) weights
1866 d_cbr_y(0, &
1867 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1868 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1869 d_cbr_y(2, &
1870 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1871 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1872 d_cbl_y(0, &
1873 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1874 & *(s_cb(i + 3) - s_cb(i - 1)))
1875 d_cbl_y(2, &
1876 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1877 & *(s_cb(i - 2) - s_cb(i + 3)))
1878
1879 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1880 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1881
1882 ! Smoothness indicator coefficients
1883 beta_coef_y(i + 1, 0, &
1884 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1885 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1886 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1887
1888 beta_coef_y(i + 1, 0, &
1889 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1890 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1891 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1892 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1893
1894 beta_coef_y(i + 1, 0, &
1895 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1896 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1897 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1898 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1899
1900 beta_coef_y(i + 1, 1, &
1901 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1902 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1903 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1904
1905 beta_coef_y(i + 1, 1, &
1906 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1907 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1908 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1909 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1910
1911 beta_coef_y(i + 1, 1, &
1912 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1913 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1914 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1915
1916 beta_coef_y(i + 1, 2, &
1917 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1918 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1919 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1920 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1921
1922 beta_coef_y(i + 1, 2, &
1923 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1924 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1925 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1926 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1927
1928 beta_coef_y(i + 1, 2, &
1929 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1930 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1931 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1932 end do
1933
1934 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1935 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1936 if (null_weights) then
1937 if (bc_s%beg == bc_riemann_extrap) then
1938 d_cbr_y(1:2,0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1939 d_cbl_y(1:2,0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1940 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:,1) = d_cbr_y(:,1)/sum(d_cbr_y(:,1))
1941 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:,1) = d_cbl_y(:,1)/sum(d_cbl_y(:,1))
1942 end if
1943
1944 if (bc_s%end == bc_riemann_extrap) then
1945 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:,s - 1) = d_cbr_y(:, &
1946 & s - 1)/sum(d_cbr_y(:,s - 1))
1947 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:,s - 1) = d_cbl_y(:, &
1948 & s - 1)/sum(d_cbl_y(:,s - 1))
1949 d_cbr_y(0:1,s) = 0._wp; d_cbr_y(2, s) = 1._wp
1950 d_cbl_y(0:1,s) = 0._wp; d_cbl_y(2, s) = 1._wp
1951 end if
1952 end if
1953 else
1954 if (.not. teno) then
1955 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1956 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1957 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1958 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1959 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1960 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1961 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1962 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1963 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1964 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1965 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1966 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1967
1968 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1969 d_cbr_y(0, &
1970 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1971 & *(w(1) - w(8)))
1972 d_cbr_y(1, &
1973 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1974 & *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) &
1975 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1976 & *(w(2) - w(8)))
1977 d_cbr_y(2, &
1978 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1979 & *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) &
1980 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1981 & *(w(3) - w(8)))
1982 d_cbr_y(3, &
1983 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1984 & *(w(3) - w(8)))
1985
1986 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
1987 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
1988 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
1989 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
1990 w(1) = s_cb(i + 4) - s_cb(i)
1991 w(2) = s_cb(i + 3) - s_cb(i)
1992 w(3) = s_cb(i + 2) - s_cb(i)
1993 w(4) = s_cb(i + 1) - s_cb(i)
1994 w(5) = s_cb(i) - s_cb(i)
1995 w(6) = s_cb(i - 1) - s_cb(i)
1996 w(7) = s_cb(i - 2) - s_cb(i)
1997 w(8) = s_cb(i - 3) - s_cb(i)
1998 d_cbl_y(0, &
1999 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2000 & *(w(3) - w(8)))
2001 d_cbl_y(1, &
2002 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2003 & *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) &
2004 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2005 & *(w(3) - w(8)))
2006 d_cbl_y(2, &
2007 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2008 & *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) &
2009 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2010 & *(w(2) - w(8)))
2011 d_cbl_y(3, &
2012 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2013 & *(w(1) - w(8)))
2014 ! Note: Left has the reversed order of both points and coefficients compared to the right
2015
2016 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2017 poly_coef_cbr_y(i + 1, 0, &
2018 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2019 & + y(2) + y(3) + y(4)))
2020 poly_coef_cbr_y(i + 1, 0, &
2021 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2022 & + 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) &
2023 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2024 poly_coef_cbr_y(i + 1, 0, &
2025 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2026 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2027 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2028
2029 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2030 poly_coef_cbr_y(i + 1, 1, &
2031 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2032 & + y(2) + y(3) + y(4)))
2033 poly_coef_cbr_y(i + 1, 1, &
2034 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2035 & + 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) &
2036 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2037 poly_coef_cbr_y(i + 1, 1, &
2038 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2039 & + y(2) + y(3) + y(4)))
2040
2041 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2042 poly_coef_cbr_y(i + 1, 2, &
2043 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2044 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2045 poly_coef_cbr_y(i + 1, 2, &
2046 & 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 &
2047 & + 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) &
2048 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2049 poly_coef_cbr_y(i + 1, 2, &
2050 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2051 & + y(2) + y(3) + y(4)))
2052
2053 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2054 poly_coef_cbr_y(i + 1, 3, &
2055 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2056 & + 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) &
2057 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2058 poly_coef_cbr_y(i + 1, 3, &
2059 & 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) &
2060 & + 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)) &
2061 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2062 & + y(4)))
2063 poly_coef_cbr_y(i + 1, 3, &
2064 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2065 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2066
2067 ! Element-wise: see the no-reversed-sections note above.
2068 y(1) = s_cb(i + 1) - s_cb(i)
2069 y(2) = s_cb(i) - s_cb(i - 1)
2070 y(3) = s_cb(i - 1) - s_cb(i - 2)
2071 y(4) = s_cb(i - 2) - s_cb(i - 3)
2072 poly_coef_cbl_y(i + 1, 3, &
2073 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2074 & + y(2) + y(3) + y(4)))
2075 poly_coef_cbl_y(i + 1, 3, &
2076 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2077 & + 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) &
2078 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2079 poly_coef_cbl_y(i + 1, 3, &
2080 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2081 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2082 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2083
2084 ! Element-wise: see the no-reversed-sections note above.
2085 y(1) = s_cb(i + 2) - s_cb(i + 1)
2086 y(2) = s_cb(i + 1) - s_cb(i)
2087 y(3) = s_cb(i) - s_cb(i - 1)
2088 y(4) = s_cb(i - 1) - s_cb(i - 2)
2089 poly_coef_cbl_y(i + 1, 2, &
2090 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2091 & + y(2) + y(3) + y(4)))
2092 poly_coef_cbl_y(i + 1, 2, &
2093 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2094 & + 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) &
2095 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2096 poly_coef_cbl_y(i + 1, 2, &
2097 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2098 & + y(2) + y(3) + y(4)))
2099
2100 ! Element-wise: see the no-reversed-sections note above.
2101 y(1) = s_cb(i + 3) - s_cb(i + 2)
2102 y(2) = s_cb(i + 2) - s_cb(i + 1)
2103 y(3) = s_cb(i + 1) - s_cb(i)
2104 y(4) = s_cb(i) - s_cb(i - 1)
2105 poly_coef_cbl_y(i + 1, 1, &
2106 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2107 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2108 poly_coef_cbl_y(i + 1, 1, &
2109 & 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 &
2110 & + 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) &
2111 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2112 poly_coef_cbl_y(i + 1, 1, &
2113 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2114 & + y(2) + y(3) + y(4)))
2115
2116 ! Element-wise: see the no-reversed-sections note above.
2117 y(1) = s_cb(i + 4) - s_cb(i + 3)
2118 y(2) = s_cb(i + 3) - s_cb(i + 2)
2119 y(3) = s_cb(i + 2) - s_cb(i + 1)
2120 y(4) = s_cb(i + 1) - s_cb(i)
2121 poly_coef_cbl_y(i + 1, 0, &
2122 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2123 & + 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) &
2124 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2125 poly_coef_cbl_y(i + 1, 0, &
2126 & 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) &
2127 & + 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)) &
2128 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2129 & + y(4)))
2130 poly_coef_cbl_y(i + 1, 0, &
2131 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2132 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2133
2134 poly_coef_cbl_y(i + 1,:,:) = -poly_coef_cbl_y(i + 1,:,:)
2135 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2136
2137 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2138 beta_coef_y(i + 1, 3, &
2139 & 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) &
2140 & + 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) &
2141 & **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 &
2142 & + 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) &
2143 & *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) &
2144 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2145 & + 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) &
2146 & *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) &
2147 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2148 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2149 beta_coef_y(i + 1, 3, &
2150 & 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) &
2151 & **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) &
2152 & + 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) &
2153 & + 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) &
2154 & + 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) &
2155 & *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) &
2156 & *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) &
2157 & *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) &
2158 & **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) &
2159 & **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) &
2160 & *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) &
2161 & + 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) &
2162 & *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) &
2163 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2164 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2165 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2166 beta_coef_y(i + 1, 3, &
2167 & 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) &
2168 & **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) &
2169 & + 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) &
2170 & *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 &
2171 & + 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) &
2172 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2173 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2174 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2175 beta_coef_y(i + 1, 3, &
2176 & 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 &
2177 & + 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 &
2178 & + 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 &
2179 & + 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) &
2180 & + 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) &
2181 & **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) &
2182 & **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) &
2183 & **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) &
2184 & **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) &
2185 & *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) &
2186 & **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) &
2187 & **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) &
2188 & **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) &
2189 & **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) &
2190 & **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) &
2191 & **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) &
2192 & **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) &
2193 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2194 & + 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 &
2195 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2196 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2197 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2198 & + y(3) + y(4))**2)
2199 beta_coef_y(i + 1, 3, &
2200 & 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) &
2201 & **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) &
2202 & **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) &
2203 & **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) &
2204 & *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) &
2205 & *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) &
2206 & **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) &
2207 & **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) &
2208 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2209 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2210 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2211 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2212 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2213 beta_coef_y(i + 1, 3, &
2214 & 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 &
2215 & + 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) &
2216 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2217 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2218 & + y(4))**2)
2219
2220 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2221 beta_coef_y(i + 1, 2, &
2222 & 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 &
2223 & + 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) &
2224 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2225 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2226 & + y(4))**2)
2227 beta_coef_y(i + 1, 2, &
2228 & 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 &
2229 & + 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) &
2230 & - 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 &
2231 & - 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 &
2232 & + 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 &
2233 & + 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 &
2234 & + 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 &
2235 & + 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) &
2236 & **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 &
2237 & - 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 &
2238 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2239 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2240 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2241 & **2)
2242 beta_coef_y(i + 1, 2, &
2243 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2244 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2245 & + 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) &
2246 & *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)) &
2247 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2248 & + y(4))**2)
2249 beta_coef_y(i + 1, 2, &
2250 & 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 &
2251 & + 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 &
2252 & + 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 &
2253 & + 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) &
2254 & + 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) &
2255 & **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) &
2256 & **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) &
2257 & **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) &
2258 & **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) &
2259 & *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 &
2260 & + 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) &
2261 & **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 &
2262 & + 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 &
2263 & + 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) &
2264 & **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) &
2265 & *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) &
2266 & + 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 &
2267 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2268 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2269 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2270 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2271 & + y(3) + y(4))**2)
2272 beta_coef_y(i + 1, 2, &
2273 & 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) &
2274 & **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) &
2275 & *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) &
2276 & *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) &
2277 & *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) &
2278 & **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) &
2279 & **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) &
2280 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2281 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2282 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2283 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2284 & **2)
2285 beta_coef_y(i + 1, 2, &
2286 & 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 &
2287 & - 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)) &
2288 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2289
2290 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2291 beta_coef_y(i + 1, 1, &
2292 & 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 &
2293 & - 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)) &
2294 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2295 beta_coef_y(i + 1, 1, &
2296 & 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) &
2297 & *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) &
2298 & **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) &
2299 & **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) &
2300 & **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) &
2301 & **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) &
2302 & **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) &
2303 & *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) &
2304 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2305 & **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) &
2306 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2307 & + y(3) + y(4))**2)
2308 beta_coef_y(i + 1, 1, &
2309 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2310 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2311 & + 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) &
2312 & *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)) &
2313 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2314 & + y(4))**2)
2315 beta_coef_y(i + 1, 1, &
2316 & 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) &
2317 & + 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) &
2318 & **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) &
2319 & **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) &
2320 & **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) &
2321 & **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) &
2322 & + 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) &
2323 & **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) &
2324 & **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) &
2325 & **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) &
2326 & **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) &
2327 & - 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) &
2328 & **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) &
2329 & **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) &
2330 & *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) &
2331 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2332 & **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) &
2333 & **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) &
2334 & **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) &
2335 & **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) &
2336 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2337 beta_coef_y(i + 1, 1, &
2338 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2339 & **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) &
2340 & **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) &
2341 & *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) &
2342 & + 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) &
2343 & **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) &
2344 & **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) &
2345 & **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) &
2346 & **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 &
2347 & - 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 &
2348 & - 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) &
2349 & **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) &
2350 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2351 beta_coef_y(i + 1, 1, &
2352 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2353 & **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 &
2354 & + 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) &
2355 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2356 & + y(3) + y(4))**2)
2357
2358 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2359 beta_coef_y(i + 1, 0, &
2360 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2361 & **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 &
2362 & + 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) &
2363 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2364 & + y(3) + y(4))**2)
2365 beta_coef_y(i + 1, 0, &
2366 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2367 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2368 & **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) &
2369 & **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) &
2370 & + 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) &
2371 & **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 &
2372 & + 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) &
2373 & **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) &
2374 & *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 &
2375 & + 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) &
2376 & + 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) &
2377 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2378 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2379 beta_coef_y(i + 1, 0, &
2380 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2381 & *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) &
2382 & + 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) &
2383 & **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) &
2384 & + 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) &
2385 & *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) &
2386 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2387 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2388 beta_coef_y(i + 1, 0, &
2389 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2390 & **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) &
2391 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2392 & + 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) &
2393 & + 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) &
2394 & *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) &
2395 & *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) &
2396 & + 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) &
2397 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2398 & + 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) &
2399 & **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) &
2400 & **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) &
2401 & *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) &
2402 & **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) &
2403 & **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 &
2404 & + 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) &
2405 & + 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 &
2406 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2407 & + 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) &
2408 & **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) &
2409 & **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) &
2410 & **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)) &
2411 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2412 beta_coef_y(i + 1, 0, &
2413 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
2414 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
2415 & **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) &
2416 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
2417 & **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) &
2418 & **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) &
2419 & **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) &
2420 & + 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) &
2421 & + 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) &
2422 & + 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) &
2423 & *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 &
2424 & + 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) &
2425 & *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) &
2426 & + 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) &
2427 & **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)) &
2428 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2429 & + y(4))**2)
2430 beta_coef_y(i + 1, 0, &
2431 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
2432 & **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) &
2433 & + 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) &
2434 & *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 &
2435 & + 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) &
2436 & **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) &
2437 & + 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) &
2438 & **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) &
2439 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2440 & + y(3) + y(4))**2)
2441 end do
2442 else
2443 ! (Fu, et al., 2016) Table 2 (for right flux)
2444 d_cbl_y(0,:) = 18._wp/35._wp
2445 d_cbl_y(1,:) = 3._wp/35._wp
2446 d_cbl_y(2,:) = 9._wp/35._wp
2447 d_cbl_y(3,:) = 1._wp/35._wp
2448 d_cbl_y(4,:) = 4._wp/35._wp
2449
2450 d_cbr_y(0,:) = 18._wp/35._wp
2451 d_cbr_y(1,:) = 9._wp/35._wp
2452 d_cbr_y(2,:) = 3._wp/35._wp
2453 d_cbr_y(3,:) = 4._wp/35._wp
2454 d_cbr_y(4,:) = 1._wp/35._wp
2455 end if
2456 end if
2457 end if
2458# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2459 ! Computing WENO3 Coefficients
2460 if (weno_dir == 3) then
2461 if (weno_order == 3) then
2462 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2463 ! Polynomial reconstruction coefficients
2464 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
2465 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
2466
2467 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
2468 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
2469
2470 ! Ideal (linear) weights
2471 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
2472 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
2473
2474 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
2475 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
2476
2477 ! Smoothness indicator coefficients
2478 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
2479 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
2480 end do
2481
2482 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2483 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2484 if (null_weights) then
2485 if (bc_s%beg == bc_riemann_extrap) then
2486 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2487 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2488 end if
2489
2490 if (bc_s%end == bc_riemann_extrap) then
2491 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
2492 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
2493 end if
2494 end if
2495 ! END: Computing WENO3 Coefficients
2496
2497 ! Computing WENO5 Coefficients
2498 else if (weno_order == 5) then
2499 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2500 ! Polynomial reconstruction coefficients
2501 poly_coef_cbr_z(i + 1, 0, &
2502 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
2503 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2504 poly_coef_cbr_z(i + 1, 1, &
2505 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
2506 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
2507 poly_coef_cbr_z(i + 1, 1, &
2508 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
2509 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2510 poly_coef_cbr_z(i + 1, 2, &
2511 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2512 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2513 poly_coef_cbl_z(i + 1, 0, &
2514 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
2515 & *(s_cb(i + 3) - s_cb(i + 1)))
2516 poly_coef_cbl_z(i + 1, 1, &
2517 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
2518 & + 2))*(s_cb(i) - s_cb(i + 2)))
2519 poly_coef_cbl_z(i + 1, 1, &
2520 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
2521 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2522 poly_coef_cbl_z(i + 1, 2, &
2523 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
2524 & *(s_cb(i - 2) - s_cb(i + 1)))
2525
2526 poly_coef_cbr_z(i + 1, 0, &
2527 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
2528 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
2529 poly_coef_cbr_z(i + 1, 2, &
2530 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
2531 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
2532 poly_coef_cbl_z(i + 1, 0, &
2533 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
2534 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
2535 poly_coef_cbl_z(i + 1, 2, &
2536 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
2537 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
2538
2539 ! Ideal (linear) weights
2540 d_cbr_z(0, &
2541 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2542 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2543 d_cbr_z(2, &
2544 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
2545 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2546 d_cbl_z(0, &
2547 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
2548 & *(s_cb(i + 3) - s_cb(i - 1)))
2549 d_cbl_z(2, &
2550 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
2551 & *(s_cb(i - 2) - s_cb(i + 3)))
2552
2553 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2554 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2555
2556 ! Smoothness indicator coefficients
2557 beta_coef_z(i + 1, 0, &
2558 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2559 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2560 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2561
2562 beta_coef_z(i + 1, 0, &
2563 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2564 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
2565 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
2566 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
2567
2568 beta_coef_z(i + 1, 0, &
2569 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2570 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
2571 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
2572 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2573
2574 beta_coef_z(i + 1, 1, &
2575 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2576 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2577 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2578
2579 beta_coef_z(i + 1, 1, &
2580 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
2581 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
2582 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
2583 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
2584
2585 beta_coef_z(i + 1, 1, &
2586 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2587 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2588 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
2589
2590 beta_coef_z(i + 1, 2, &
2591 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2592 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
2593 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
2594 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
2595
2596 beta_coef_z(i + 1, 2, &
2597 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2598 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
2599 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
2600 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
2601
2602 beta_coef_z(i + 1, 2, &
2603 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2604 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2605 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2606 end do
2607
2608 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2609 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2610 if (null_weights) then
2611 if (bc_s%beg == bc_riemann_extrap) then
2612 d_cbr_z(1:2,0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2613 d_cbl_z(1:2,0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2614 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:,1) = d_cbr_z(:,1)/sum(d_cbr_z(:,1))
2615 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:,1) = d_cbl_z(:,1)/sum(d_cbl_z(:,1))
2616 end if
2617
2618 if (bc_s%end == bc_riemann_extrap) then
2619 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:,s - 1) = d_cbr_z(:, &
2620 & s - 1)/sum(d_cbr_z(:,s - 1))
2621 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:,s - 1) = d_cbl_z(:, &
2622 & s - 1)/sum(d_cbl_z(:,s - 1))
2623 d_cbr_z(0:1,s) = 0._wp; d_cbr_z(2, s) = 1._wp
2624 d_cbl_z(0:1,s) = 0._wp; d_cbl_z(2, s) = 1._wp
2625 end if
2626 end if
2627 else
2628 if (.not. teno) then
2629 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2630 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
2631 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
2632 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
2633 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
2634 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
2635 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2636 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
2637 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
2638 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
2639 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
2640 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2641
2642 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2643 d_cbr_z(0, &
2644 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2645 & *(w(1) - w(8)))
2646 d_cbr_z(1, &
2647 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2648 & *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) &
2649 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2650 & *(w(2) - w(8)))
2651 d_cbr_z(2, &
2652 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2653 & *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) &
2654 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2655 & *(w(3) - w(8)))
2656 d_cbr_z(3, &
2657 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2658 & *(w(3) - w(8)))
2659
2660 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
2661 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
2662 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
2663 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
2664 w(1) = s_cb(i + 4) - s_cb(i)
2665 w(2) = s_cb(i + 3) - s_cb(i)
2666 w(3) = s_cb(i + 2) - s_cb(i)
2667 w(4) = s_cb(i + 1) - s_cb(i)
2668 w(5) = s_cb(i) - s_cb(i)
2669 w(6) = s_cb(i - 1) - s_cb(i)
2670 w(7) = s_cb(i - 2) - s_cb(i)
2671 w(8) = s_cb(i - 3) - s_cb(i)
2672 d_cbl_z(0, &
2673 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2674 & *(w(3) - w(8)))
2675 d_cbl_z(1, &
2676 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2677 & *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) &
2678 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2679 & *(w(3) - w(8)))
2680 d_cbl_z(2, &
2681 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2682 & *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) &
2683 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2684 & *(w(2) - w(8)))
2685 d_cbl_z(3, &
2686 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2687 & *(w(1) - w(8)))
2688 ! Note: Left has the reversed order of both points and coefficients compared to the right
2689
2690 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2691 poly_coef_cbr_z(i + 1, 0, &
2692 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2693 & + y(2) + y(3) + y(4)))
2694 poly_coef_cbr_z(i + 1, 0, &
2695 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2696 & + 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) &
2697 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2698 poly_coef_cbr_z(i + 1, 0, &
2699 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2700 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2701 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2702
2703 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2704 poly_coef_cbr_z(i + 1, 1, &
2705 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2706 & + y(2) + y(3) + y(4)))
2707 poly_coef_cbr_z(i + 1, 1, &
2708 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2709 & + 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) &
2710 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2711 poly_coef_cbr_z(i + 1, 1, &
2712 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2713 & + y(2) + y(3) + y(4)))
2714
2715 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2716 poly_coef_cbr_z(i + 1, 2, &
2717 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2718 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2719 poly_coef_cbr_z(i + 1, 2, &
2720 & 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 &
2721 & + 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) &
2722 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2723 poly_coef_cbr_z(i + 1, 2, &
2724 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2725 & + y(2) + y(3) + y(4)))
2726
2727 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2728 poly_coef_cbr_z(i + 1, 3, &
2729 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2730 & + 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) &
2731 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2732 poly_coef_cbr_z(i + 1, 3, &
2733 & 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) &
2734 & + 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)) &
2735 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2736 & + y(4)))
2737 poly_coef_cbr_z(i + 1, 3, &
2738 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2739 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2740
2741 ! Element-wise: see the no-reversed-sections note above.
2742 y(1) = s_cb(i + 1) - s_cb(i)
2743 y(2) = s_cb(i) - s_cb(i - 1)
2744 y(3) = s_cb(i - 1) - s_cb(i - 2)
2745 y(4) = s_cb(i - 2) - s_cb(i - 3)
2746 poly_coef_cbl_z(i + 1, 3, &
2747 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2748 & + y(2) + y(3) + y(4)))
2749 poly_coef_cbl_z(i + 1, 3, &
2750 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2751 & + 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) &
2752 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2753 poly_coef_cbl_z(i + 1, 3, &
2754 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2755 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2756 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2757
2758 ! Element-wise: see the no-reversed-sections note above.
2759 y(1) = s_cb(i + 2) - s_cb(i + 1)
2760 y(2) = s_cb(i + 1) - s_cb(i)
2761 y(3) = s_cb(i) - s_cb(i - 1)
2762 y(4) = s_cb(i - 1) - s_cb(i - 2)
2763 poly_coef_cbl_z(i + 1, 2, &
2764 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2765 & + y(2) + y(3) + y(4)))
2766 poly_coef_cbl_z(i + 1, 2, &
2767 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2768 & + 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) &
2769 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2770 poly_coef_cbl_z(i + 1, 2, &
2771 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2772 & + y(2) + y(3) + y(4)))
2773
2774 ! Element-wise: see the no-reversed-sections note above.
2775 y(1) = s_cb(i + 3) - s_cb(i + 2)
2776 y(2) = s_cb(i + 2) - s_cb(i + 1)
2777 y(3) = s_cb(i + 1) - s_cb(i)
2778 y(4) = s_cb(i) - s_cb(i - 1)
2779 poly_coef_cbl_z(i + 1, 1, &
2780 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2781 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2782 poly_coef_cbl_z(i + 1, 1, &
2783 & 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 &
2784 & + 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) &
2785 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2786 poly_coef_cbl_z(i + 1, 1, &
2787 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2788 & + y(2) + y(3) + y(4)))
2789
2790 ! Element-wise: see the no-reversed-sections note above.
2791 y(1) = s_cb(i + 4) - s_cb(i + 3)
2792 y(2) = s_cb(i + 3) - s_cb(i + 2)
2793 y(3) = s_cb(i + 2) - s_cb(i + 1)
2794 y(4) = s_cb(i + 1) - s_cb(i)
2795 poly_coef_cbl_z(i + 1, 0, &
2796 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2797 & + 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) &
2798 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2799 poly_coef_cbl_z(i + 1, 0, &
2800 & 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) &
2801 & + 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)) &
2802 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2803 & + y(4)))
2804 poly_coef_cbl_z(i + 1, 0, &
2805 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2806 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2807
2808 poly_coef_cbl_z(i + 1,:,:) = -poly_coef_cbl_z(i + 1,:,:)
2809 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2810
2811 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2812 beta_coef_z(i + 1, 3, &
2813 & 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) &
2814 & + 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) &
2815 & **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 &
2816 & + 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) &
2817 & *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) &
2818 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2819 & + 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) &
2820 & *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) &
2821 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2822 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2823 beta_coef_z(i + 1, 3, &
2824 & 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) &
2825 & **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) &
2826 & + 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) &
2827 & + 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) &
2828 & + 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) &
2829 & *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) &
2830 & *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) &
2831 & *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) &
2832 & **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) &
2833 & **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) &
2834 & *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) &
2835 & + 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) &
2836 & *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) &
2837 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2838 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2839 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2840 beta_coef_z(i + 1, 3, &
2841 & 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) &
2842 & **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) &
2843 & + 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) &
2844 & *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 &
2845 & + 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) &
2846 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2847 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2848 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2849 beta_coef_z(i + 1, 3, &
2850 & 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 &
2851 & + 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 &
2852 & + 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 &
2853 & + 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) &
2854 & + 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) &
2855 & **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) &
2856 & **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) &
2857 & **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) &
2858 & **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) &
2859 & *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) &
2860 & **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) &
2861 & **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) &
2862 & **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) &
2863 & **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) &
2864 & **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) &
2865 & **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) &
2866 & **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) &
2867 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2868 & + 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 &
2869 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2870 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2871 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2872 & + y(3) + y(4))**2)
2873 beta_coef_z(i + 1, 3, &
2874 & 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) &
2875 & **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) &
2876 & **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) &
2877 & **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) &
2878 & *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) &
2879 & *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) &
2880 & **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) &
2881 & **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) &
2882 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2883 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2884 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2885 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2886 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2887 beta_coef_z(i + 1, 3, &
2888 & 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 &
2889 & + 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) &
2890 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2891 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2892 & + y(4))**2)
2893
2894 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2895 beta_coef_z(i + 1, 2, &
2896 & 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 &
2897 & + 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) &
2898 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2899 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2900 & + y(4))**2)
2901 beta_coef_z(i + 1, 2, &
2902 & 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 &
2903 & + 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) &
2904 & - 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 &
2905 & - 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 &
2906 & + 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 &
2907 & + 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 &
2908 & + 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 &
2909 & + 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) &
2910 & **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 &
2911 & - 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 &
2912 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2913 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2914 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2915 & **2)
2916 beta_coef_z(i + 1, 2, &
2917 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2918 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2919 & + 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) &
2920 & *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)) &
2921 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2922 & + y(4))**2)
2923 beta_coef_z(i + 1, 2, &
2924 & 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 &
2925 & + 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 &
2926 & + 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 &
2927 & + 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) &
2928 & + 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) &
2929 & **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) &
2930 & **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) &
2931 & **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) &
2932 & **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) &
2933 & *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 &
2934 & + 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) &
2935 & **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 &
2936 & + 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 &
2937 & + 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) &
2938 & **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) &
2939 & *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) &
2940 & + 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 &
2941 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2942 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2943 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2944 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2945 & + y(3) + y(4))**2)
2946 beta_coef_z(i + 1, 2, &
2947 & 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) &
2948 & **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) &
2949 & *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) &
2950 & *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) &
2951 & *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) &
2952 & **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) &
2953 & **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) &
2954 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2955 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2956 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2957 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2958 & **2)
2959 beta_coef_z(i + 1, 2, &
2960 & 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 &
2961 & - 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)) &
2962 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2963
2964 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2965 beta_coef_z(i + 1, 1, &
2966 & 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 &
2967 & - 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)) &
2968 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2969 beta_coef_z(i + 1, 1, &
2970 & 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) &
2971 & *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) &
2972 & **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) &
2973 & **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) &
2974 & **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) &
2975 & **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) &
2976 & **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) &
2977 & *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) &
2978 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2979 & **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) &
2980 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2981 & + y(3) + y(4))**2)
2982 beta_coef_z(i + 1, 1, &
2983 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2984 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2985 & + 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) &
2986 & *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)) &
2987 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2988 & + y(4))**2)
2989 beta_coef_z(i + 1, 1, &
2990 & 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) &
2991 & + 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) &
2992 & **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) &
2993 & **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) &
2994 & **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) &
2995 & **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) &
2996 & + 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) &
2997 & **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) &
2998 & **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) &
2999 & **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) &
3000 & **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) &
3001 & - 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) &
3002 & **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) &
3003 & **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) &
3004 & *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) &
3005 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
3006 & **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) &
3007 & **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) &
3008 & **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) &
3009 & **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) &
3010 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3011 beta_coef_z(i + 1, 1, &
3012 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
3013 & **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) &
3014 & **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) &
3015 & *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) &
3016 & + 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) &
3017 & **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) &
3018 & **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) &
3019 & **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) &
3020 & **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 &
3021 & - 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 &
3022 & - 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) &
3023 & **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) &
3024 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3025 beta_coef_z(i + 1, 1, &
3026 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
3027 & **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 &
3028 & + 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) &
3029 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3030 & + y(3) + y(4))**2)
3031
3032 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
3033 beta_coef_z(i + 1, 0, &
3034 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
3035 & **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 &
3036 & + 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) &
3037 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
3038 & + y(3) + y(4))**2)
3039 beta_coef_z(i + 1, 0, &
3040 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
3041 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
3042 & **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) &
3043 & **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) &
3044 & + 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) &
3045 & **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 &
3046 & + 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) &
3047 & **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) &
3048 & *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 &
3049 & + 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) &
3050 & + 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) &
3051 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
3052 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3053 beta_coef_z(i + 1, 0, &
3054 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
3055 & *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) &
3056 & + 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) &
3057 & **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) &
3058 & + 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) &
3059 & *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) &
3060 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
3061 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3062 beta_coef_z(i + 1, 0, &
3063 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
3064 & **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) &
3065 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
3066 & + 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) &
3067 & + 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) &
3068 & *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) &
3069 & *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) &
3070 & + 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) &
3071 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
3072 & + 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) &
3073 & **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) &
3074 & **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) &
3075 & *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) &
3076 & **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) &
3077 & **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 &
3078 & + 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) &
3079 & + 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 &
3080 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
3081 & + 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) &
3082 & **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) &
3083 & **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) &
3084 & **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)) &
3085 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3086 beta_coef_z(i + 1, 0, &
3087 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
3088 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
3089 & **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) &
3090 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
3091 & **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) &
3092 & **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) &
3093 & **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) &
3094 & + 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) &
3095 & + 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) &
3096 & + 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) &
3097 & *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 &
3098 & + 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) &
3099 & *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) &
3100 & + 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) &
3101 & **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)) &
3102 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
3103 & + y(4))**2)
3104 beta_coef_z(i + 1, 0, &
3105 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
3106 & **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) &
3107 & + 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) &
3108 & *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 &
3109 & + 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) &
3110 & **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) &
3111 & + 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) &
3112 & **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) &
3113 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3114 & + y(3) + y(4))**2)
3115 end do
3116 else
3117 ! (Fu, et al., 2016) Table 2 (for right flux)
3118 d_cbl_z(0,:) = 18._wp/35._wp
3119 d_cbl_z(1,:) = 3._wp/35._wp
3120 d_cbl_z(2,:) = 9._wp/35._wp
3121 d_cbl_z(3,:) = 1._wp/35._wp
3122 d_cbl_z(4,:) = 4._wp/35._wp
3123
3124 d_cbr_z(0,:) = 18._wp/35._wp
3125 d_cbr_z(1,:) = 9._wp/35._wp
3126 d_cbr_z(2,:) = 3._wp/35._wp
3127 d_cbr_z(3,:) = 4._wp/35._wp
3128 d_cbr_z(4,:) = 1._wp/35._wp
3129 end if
3130 end if
3131 end if
3132# 868 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3133
3134 ! Detect whether grid spacing is uniform (enables cancellation-free sum-of-squares beta). Tolerance uses sqrt(epsilon) so it
3135 ! works in both double and single precision: ~1.5e-8 relative in double, ~3.5e-4 in single - above FP noise, below real
3136 ! stretching.
3137 uniform_grid(weno_dir) = .true.
3138 h0 = (s_cb(s) - s_cb(0))/real(s, wp)
3139 do i = 0, s - 1
3140 if (abs((s_cb(i + 1) - s_cb(i)) - h0) > sqrt(epsilon(h0))*abs(h0)) then
3141 uniform_grid(weno_dir) = .false.
3142 exit
3143 end if
3144 end do
3145
3146 if (weno_dir == 1) then
3147
3148# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3149#if defined(MFC_OpenACC)
3150# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3151!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3152# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3153#elif defined(MFC_OpenMP)
3154# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3155!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3156# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3157#endif
3158 else if (weno_dir == 2) then
3159
3160# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3161#if defined(MFC_OpenACC)
3162# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3163!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3164# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3165#elif defined(MFC_OpenMP)
3166# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3167!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3168# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3169#endif
3170 else
3171
3172# 886 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3173#if defined(MFC_OpenACC)
3174# 886 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3175!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3176# 886 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3177#elif defined(MFC_OpenMP)
3178# 886 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3179!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3180# 886 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3181#endif
3182 end if
3183
3184 ! Nullifying WENO coefficients and cell-boundary locations pointers
3185
3186 nullify (s_cb)
3187
3188 end subroutine s_compute_weno_coefficients
3189
3190 subroutine s_pack_weno_input_arr(v_vf)
3191
3192 type(scalar_field), dimension(1:), intent(in) :: v_vf
3193 integer :: i, j, k, l, n_vars
3194
3195
3196# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3197
3198# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199#if defined(MFC_OpenACC)
3200# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201!$acc parallel loop collapse(4) gang vector default(present)
3202# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203#elif defined(MFC_OpenMP)
3204# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3205
3206# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3207
3208# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3209
3210# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3211!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3212# 900 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3213#endif
3214 do i = 1, v_size
3215 do l = idwbuff(3)%beg, idwbuff(3)%end
3216 do k = idwbuff(2)%beg, idwbuff(2)%end
3217 do j = idwbuff(1)%beg, idwbuff(1)%end
3218 v_rs_weno(j, k, l, i) = v_vf(i)%sf(j, k, l)
3219 end do
3220 end do
3221 end do
3222 end do
3223
3224# 910 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3225#if defined(MFC_OpenACC)
3226# 910 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3227!$acc end parallel loop
3228# 910 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3229#elif defined(MFC_OpenMP)
3230# 910 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3231
3232# 910 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3233!$omp end target teams loop
3234# 910 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3235#endif
3236
3237 end subroutine s_pack_weno_input_arr
3238
3239 !> Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables
3240 subroutine s_weno(v_vf, vL_rs_vf_x, vR_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
3241
3242 type(scalar_field), dimension(1:), intent(in) :: v_vf
3243 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x
3244 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vr_rs_vf_x
3245 integer, intent(in) :: weno_dir
3246 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
3247
3248# 931 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3249 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
3250 real(wp), dimension(0:weno_num_stencils) :: poly
3251 real(wp), dimension(0:weno_num_stencils) :: alpha
3252 real(wp), dimension(0:weno_num_stencils) :: omega
3253 real(wp), dimension(0:weno_num_stencils) :: beta
3254 real(wp), dimension(0:weno_num_stencils) :: delta
3255# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3256 real(wp), dimension(-3:3) :: v !< temporary field value array for clarity (WENO7 only)
3257 real(wp) :: tau
3258 integer :: i, j, k, l, q
3259 real(wp) :: vp0, vp1, vp2, vp3, vm1, vm2, vm3
3260
3261 is1_weno = is1_weno_d
3262 is2_weno = is2_weno_d
3263 is3_weno = is3_weno_d
3264
3265
3266# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3267#if defined(MFC_OpenACC)
3268# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3269!$acc update device(is1_weno, is2_weno, is3_weno)
3270# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3271#elif defined(MFC_OpenMP)
3272# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3273!$omp target update to(is1_weno, is2_weno, is3_weno)
3274# 947 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3275#endif
3276
3277 v_size = ubound(v_vf, 1)
3278
3279# 950 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3280#if defined(MFC_OpenACC)
3281# 950 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3282!$acc update device(v_size)
3283# 950 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3284#elif defined(MFC_OpenMP)
3285# 950 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3286!$omp target update to(v_size)
3287# 950 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3288#endif
3289
3290 if (weno_order == 1) then
3291 if (weno_dir == 1) then
3292
3293# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3294
3295# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3296#if defined(MFC_OpenACC)
3297# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3298!$acc parallel loop collapse(4) gang vector default(present)
3299# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3300#elif defined(MFC_OpenMP)
3301# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3302
3303# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3304
3305# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3306
3307# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3308!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3309# 954 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3310#endif
3311 do i = 1, v_size
3312 do l = is3_weno%beg, is3_weno%end
3313 do k = is2_weno%beg, is2_weno%end
3314 do j = is1_weno%beg, is1_weno%end
3315 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3316 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3317 end do
3318 end do
3319 end do
3320 end do
3321
3322# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3323#if defined(MFC_OpenACC)
3324# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3325!$acc end parallel loop
3326# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3327#elif defined(MFC_OpenMP)
3328# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3329
3330# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3331!$omp end target teams loop
3332# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3333#endif
3334 else if (weno_dir == 2) then
3335
3336# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3337
3338# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3339#if defined(MFC_OpenACC)
3340# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3341!$acc parallel loop collapse(4) gang vector default(present)
3342# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3343#elif defined(MFC_OpenMP)
3344# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3345
3346# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3347
3348# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3349
3350# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3351!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3352# 967 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3353#endif
3354 do i = 1, v_size
3355 do l = is3_weno%beg, is3_weno%end
3356 do j = is1_weno%beg, is1_weno%end
3357 do k = is2_weno%beg, is2_weno%end
3358 vl_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3359 vr_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3360 end do
3361 end do
3362 end do
3363 end do
3364
3365# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3366#if defined(MFC_OpenACC)
3367# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3368!$acc end parallel loop
3369# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3370#elif defined(MFC_OpenMP)
3371# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3372
3373# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3374!$omp end target teams loop
3375# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3376#endif
3377 else if (weno_dir == 3) then
3378
3379# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3380
3381# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3382#if defined(MFC_OpenACC)
3383# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3384!$acc parallel loop collapse(4) gang vector default(present)
3385# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3386#elif defined(MFC_OpenMP)
3387# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3388
3389# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3390
3391# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3392
3393# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3394!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3395# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3396#endif
3397 do i = 1, v_size
3398 do j = is1_weno%beg, is1_weno%end
3399 do k = is2_weno%beg, is2_weno%end
3400 do l = is3_weno%beg, is3_weno%end
3401 vl_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3402 vr_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3403 end do
3404 end do
3405 end do
3406 end do
3407
3408# 991 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3409#if defined(MFC_OpenACC)
3410# 991 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3411!$acc end parallel loop
3412# 991 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3413#elif defined(MFC_OpenMP)
3414# 991 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3415
3416# 991 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3417!$omp end target teams loop
3418# 991 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3419#endif
3420 end if
3421 end if
3422
3423 if (weno_order /= 1) then
3424 call s_pack_weno_input_arr(v_vf)
3425 end if
3426
3427 if (weno_order == 3) then
3428# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3429# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3430# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3431 if (weno_dir == 1) then
3432
3433# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3434
3435# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3436#if defined(MFC_OpenACC)
3437# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3438!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3439# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3440#elif defined(MFC_OpenMP)
3441# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3442
3443# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3444
3445# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3446
3447# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3448!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3449# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3450!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3451# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3452#endif
3453 do l = is3_weno%beg, is3_weno%end
3454 do k = is2_weno%beg, is2_weno%end
3455 do j = is1_weno%beg, is1_weno%end
3456 do i = 1, v_size
3457 ! reconstruct from left side
3458
3459 alpha(:) = 0._wp
3460
3461 vp0 = v_rs_weno(j, k, l, i)
3462 vm1 = v_rs_weno(j - 1, k, l, i)
3463 vp1 = v_rs_weno(j + 1, k, l, i)
3464
3465 dvd(0) = vp1 - vp0
3466 dvd(-1) = vp0 - vm1
3467
3468 poly(0) = vp0 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
3469 poly(1) = vp0 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
3470
3471 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3472 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3473
3474 if (wenojs) then
3475 do q = 0, weno_num_stencils
3476 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3477 end do
3478 else if (mapped_weno) then
3479 do q = 0, weno_num_stencils
3480 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3481 end do
3482 omega = alpha/sum(alpha)
3483 do q = 0, weno_num_stencils
3484 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3485 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3486 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3487 end do
3488 else if (wenoz) then
3489 ! Borges, et al. (2008)
3490 tau = abs(beta(1) - beta(0))
3491 do q = 0, weno_num_stencils
3492 alpha(q) = d_cbl_x(q, j)*(1._wp + tau/beta(q))
3493 end do
3494 end if
3495 omega = alpha/sum(alpha)
3496
3497 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3498
3499 ! reconstruct from right side
3500
3501 poly(0) = vp0 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3502 poly(1) = vp0 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3503
3504 if (wenojs) then
3505 do q = 0, weno_num_stencils
3506 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3507 end do
3508 else if (mapped_weno) then
3509 do q = 0, weno_num_stencils
3510 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3511 end do
3512 omega = alpha/sum(alpha)
3513 do q = 0, weno_num_stencils
3514 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3515 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3516 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3517 end do
3518 else if (wenoz) then
3519 do q = 0, weno_num_stencils
3520 alpha(q) = d_cbr_x(q, j)*(1._wp + tau/beta(q))
3521 end do
3522 end if
3523 omega = alpha/sum(alpha)
3524
3525 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3526 end do
3527 end do
3528 end do
3529 end do
3530
3531# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3532#if defined(MFC_OpenACC)
3533# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3534!$acc end parallel loop
3535# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3536#elif defined(MFC_OpenMP)
3537# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3538
3539# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3540!$omp end target teams loop
3541# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3542#endif
3543 end if
3544# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3545# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3546# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3547 if (weno_dir == 2) then
3548
3549# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3550
3551# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3552#if defined(MFC_OpenACC)
3553# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3554!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3555# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3556#elif defined(MFC_OpenMP)
3557# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3558
3559# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3560
3561# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3562
3563# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3564!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3565# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3566!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3567# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3568#endif
3569 do l = is3_weno%beg, is3_weno%end
3570 do k = is1_weno%beg, is1_weno%end
3571 do j = is2_weno%beg, is2_weno%end
3572 do i = 1, v_size
3573 ! reconstruct from left side
3574
3575 alpha(:) = 0._wp
3576
3577 vp0 = v_rs_weno(j, k, l, i)
3578 vm1 = v_rs_weno(j, k - 1, l, i)
3579 vp1 = v_rs_weno(j, k + 1, l, i)
3580
3581 dvd(0) = vp1 - vp0
3582 dvd(-1) = vp0 - vm1
3583
3584 poly(0) = vp0 + poly_coef_cbl_y(k, 0, 0)*dvd(0)
3585 poly(1) = vp0 + poly_coef_cbl_y(k, 1, 0)*dvd(-1)
3586
3587 beta(0) = beta_coef_y(k, 0, 0)*dvd(0)*dvd(0) + weno_eps
3588 beta(1) = beta_coef_y(k, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3589
3590 if (wenojs) then
3591 do q = 0, weno_num_stencils
3592 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3593 end do
3594 else if (mapped_weno) then
3595 do q = 0, weno_num_stencils
3596 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3597 end do
3598 omega = alpha/sum(alpha)
3599 do q = 0, weno_num_stencils
3600 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
3601 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3602 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
3603 end do
3604 else if (wenoz) then
3605 ! Borges, et al. (2008)
3606 tau = abs(beta(1) - beta(0))
3607 do q = 0, weno_num_stencils
3608 alpha(q) = d_cbl_y(q, k)*(1._wp + tau/beta(q))
3609 end do
3610 end if
3611 omega = alpha/sum(alpha)
3612
3613 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3614
3615 ! reconstruct from right side
3616
3617 poly(0) = vp0 + poly_coef_cbr_y(k, 0, 0)*dvd(0)
3618 poly(1) = vp0 + poly_coef_cbr_y(k, 1, 0)*dvd(-1)
3619
3620 if (wenojs) then
3621 do q = 0, weno_num_stencils
3622 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3623 end do
3624 else if (mapped_weno) then
3625 do q = 0, weno_num_stencils
3626 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3627 end do
3628 omega = alpha/sum(alpha)
3629 do q = 0, weno_num_stencils
3630 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
3631 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
3632 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
3633 end do
3634 else if (wenoz) then
3635 do q = 0, weno_num_stencils
3636 alpha(q) = d_cbr_y(q, k)*(1._wp + tau/beta(q))
3637 end do
3638 end if
3639 omega = alpha/sum(alpha)
3640
3641 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3642 end do
3643 end do
3644 end do
3645 end do
3646
3647# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3648#if defined(MFC_OpenACC)
3649# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3650!$acc end parallel loop
3651# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3652#elif defined(MFC_OpenMP)
3653# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3654
3655# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3656!$omp end target teams loop
3657# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3658#endif
3659 end if
3660# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3661# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3662# 1006 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3663 if (weno_dir == 3) then
3664
3665# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3666
3667# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3668#if defined(MFC_OpenACC)
3669# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3670!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3671# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3672#elif defined(MFC_OpenMP)
3673# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3674
3675# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3676
3677# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3678
3679# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3680!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3681# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3682!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3683# 1007 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3684#endif
3685 do l = is1_weno%beg, is1_weno%end
3686 do k = is2_weno%beg, is2_weno%end
3687 do j = is3_weno%beg, is3_weno%end
3688 do i = 1, v_size
3689 ! reconstruct from left side
3690
3691 alpha(:) = 0._wp
3692
3693 vp0 = v_rs_weno(j, k, l, i)
3694 vm1 = v_rs_weno(j, k, l - 1, i)
3695 vp1 = v_rs_weno(j, k, l + 1, i)
3696
3697 dvd(0) = vp1 - vp0
3698 dvd(-1) = vp0 - vm1
3699
3700 poly(0) = vp0 + poly_coef_cbl_z(l, 0, 0)*dvd(0)
3701 poly(1) = vp0 + poly_coef_cbl_z(l, 1, 0)*dvd(-1)
3702
3703 beta(0) = beta_coef_z(l, 0, 0)*dvd(0)*dvd(0) + weno_eps
3704 beta(1) = beta_coef_z(l, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3705
3706 if (wenojs) then
3707 do q = 0, weno_num_stencils
3708 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3709 end do
3710 else if (mapped_weno) then
3711 do q = 0, weno_num_stencils
3712 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3713 end do
3714 omega = alpha/sum(alpha)
3715 do q = 0, weno_num_stencils
3716 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
3717 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
3718 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
3719 end do
3720 else if (wenoz) then
3721 ! Borges, et al. (2008)
3722 tau = abs(beta(1) - beta(0))
3723 do q = 0, weno_num_stencils
3724 alpha(q) = d_cbl_z(q, l)*(1._wp + tau/beta(q))
3725 end do
3726 end if
3727 omega = alpha/sum(alpha)
3728
3729 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3730
3731 ! reconstruct from right side
3732
3733 poly(0) = vp0 + poly_coef_cbr_z(l, 0, 0)*dvd(0)
3734 poly(1) = vp0 + poly_coef_cbr_z(l, 1, 0)*dvd(-1)
3735
3736 if (wenojs) then
3737 do q = 0, weno_num_stencils
3738 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3739 end do
3740 else if (mapped_weno) then
3741 do q = 0, weno_num_stencils
3742 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3743 end do
3744 omega = alpha/sum(alpha)
3745 do q = 0, weno_num_stencils
3746 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
3747 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
3748 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
3749 end do
3750 else if (wenoz) then
3751 do q = 0, weno_num_stencils
3752 alpha(q) = d_cbr_z(q, l)*(1._wp + tau/beta(q))
3753 end do
3754 end if
3755 omega = alpha/sum(alpha)
3756
3757 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3758 end do
3759 end do
3760 end do
3761 end do
3762
3763# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3764#if defined(MFC_OpenACC)
3765# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3766!$acc end parallel loop
3767# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3768#elif defined(MFC_OpenMP)
3769# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3770
3771# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3772!$omp end target teams loop
3773# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3774#endif
3775 end if
3776# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3777 end if
3778 if (weno_order == 5) then
3779# 1091 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3780# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3781# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3782# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3783 if (weno_dir == 1) then
3784
3785# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3786
3787# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3788#if defined(MFC_OpenACC)
3789# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3790!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3791# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3792#elif defined(MFC_OpenMP)
3793# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3794
3795# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3796
3797# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3798
3799# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3800!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3801# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3802!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3803# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3804#endif
3805# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3806 do l = is3_weno%beg, is3_weno%end
3807 do k = is2_weno%beg, is2_weno%end
3808 do j = is1_weno%beg, is1_weno%end
3809
3810# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3811#if defined(MFC_OpenACC)
3812# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3813!$acc loop seq
3814# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3815#elif defined(MFC_OpenMP)
3816# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3817
3818# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3819#endif
3820 do i = 1, v_size
3821 ! reconstruct from left side
3822
3823 alpha(:) = 0._wp
3824
3825 vp0 = v_rs_weno(j, k, l, i)
3826 vm1 = v_rs_weno(j - 1, k, l, i)
3827 vm2 = v_rs_weno(j - 2, k, l, i)
3828 vp1 = v_rs_weno(j + 1, k, l, i)
3829 vp2 = v_rs_weno(j + 2, k, l, i)
3830
3831 dvd(1) = vp2 - vp1
3832 dvd(0) = vp1 - vp0
3833 dvd(-1) = vp0 - vm1
3834 dvd(-2) = vm1 - vm2
3835
3836 poly(0) = vp0 + poly_coef_cbl_x(j, 0, &
3837 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3838 poly(1) = vp0 + poly_coef_cbl_x(j, 1, &
3839 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3840 poly(2) = vp0 + poly_coef_cbl_x(j, 2, &
3841 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3842
3843 if (uniform_grid(1)) then
3844 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
3845 & + weno_eps
3846 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
3847 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
3848 & + weno_eps
3849 else
3850 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
3851 & 0, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3852 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
3853 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, &
3854 & 2)*dvd(-1)*dvd(-1) + weno_eps
3855 beta(2) = beta_coef_x(j, 2, &
3856 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3857 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3858 end if
3859
3860 if (wenojs) then
3861 do q = 0, weno_num_stencils
3862 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3863 end do
3864 else if (mapped_weno) then
3865 do q = 0, weno_num_stencils
3866 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3867 end do
3868 omega = alpha/sum(alpha)
3869 do q = 0, weno_num_stencils
3870 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3871 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3872 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3873 end do
3874 else if (wenoz) then
3875 ! Borges, et al. (2008)
3876
3877 tau = abs(beta(2) - beta(0)) ! Equation 25
3878
3879# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3880#if defined(MFC_OpenACC)
3881# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3882!$acc loop seq
3883# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3884#elif defined(MFC_OpenMP)
3885# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3886
3887# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3888#endif
3889 do q = 0, weno_num_stencils
3890 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3891 ! Equation 28 (note: weno_eps was already added to beta)
3892 end do
3893 else if (teno) then
3894 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3895 tau = abs(beta(2) - beta(0))
3896
3897# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3898#if defined(MFC_OpenACC)
3899# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3900!$acc loop seq
3901# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3902#elif defined(MFC_OpenMP)
3903# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3904
3905# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3906#endif
3907 do q = 0, weno_num_stencils
3908 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3909 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3910 alpha(q) = (alpha(q)**3._wp)**2._wp
3911 end do
3912 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3913
3914
3915# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3916#if defined(MFC_OpenACC)
3917# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3918!$acc loop seq
3919# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3920#elif defined(MFC_OpenMP)
3921# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3922
3923# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3924#endif
3925 do q = 0, weno_num_stencils
3926 if (omega(q) < teno_ct) then ! Equation 26
3927 delta(q) = 0._wp
3928 else
3929 delta(q) = 1._wp
3930 end if
3931 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3932 end do
3933 end if
3934
3935 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3936 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3937 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3938
3939 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3940
3941 ! reconstruct from right side
3942
3943 poly(0) = vp0 + poly_coef_cbr_x(j, 0, &
3944 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3945 poly(1) = vp0 + poly_coef_cbr_x(j, 1, &
3946 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3947 poly(2) = vp0 + poly_coef_cbr_x(j, 2, &
3948 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3949
3950 if (wenojs) then
3951 do q = 0, weno_num_stencils
3952 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3953 end do
3954 else if (mapped_weno) then
3955 do q = 0, weno_num_stencils
3956 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3957 end do
3958 omega = alpha/sum(alpha)
3959 do q = 0, weno_num_stencils
3960 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3961 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3962 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3963 end do
3964 else if (wenoz) then
3965
3966# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3967#if defined(MFC_OpenACC)
3968# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3969!$acc loop seq
3970# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3971#elif defined(MFC_OpenMP)
3972# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3973
3974# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3975#endif
3976 do q = 0, weno_num_stencils
3977 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3978 end do
3979 else if (teno) then
3980
3981# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3982#if defined(MFC_OpenACC)
3983# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3984!$acc loop seq
3985# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3986#elif defined(MFC_OpenMP)
3987# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3988
3989# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3990#endif
3991 do q = 0, weno_num_stencils
3992 alpha(q) = delta(q)*d_cbr_x(q, j)
3993 end do
3994 end if
3995
3996 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3997 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3998 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3999
4000 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4001 end do
4002 end do
4003 end do
4004 end do
4005
4006# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4007#if defined(MFC_OpenACC)
4008# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4009!$acc end parallel loop
4010# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4011#elif defined(MFC_OpenMP)
4012# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4013
4014# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4015!$omp end target teams loop
4016# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4017#endif
4018
4019 if (mp_weno) then
4020 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4021 end if
4022 end if
4023# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4024# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4025# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4026 if (weno_dir == 2) then
4027
4028# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4029
4030# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4031#if defined(MFC_OpenACC)
4032# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4033!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4034# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4035#elif defined(MFC_OpenMP)
4036# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4037
4038# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4039
4040# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4041
4042# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4043!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4044# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4045!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4046# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4047#endif
4048# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4049 do l = is3_weno%beg, is3_weno%end
4050 do k = is1_weno%beg, is1_weno%end
4051 do j = is2_weno%beg, is2_weno%end
4052
4053# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4054#if defined(MFC_OpenACC)
4055# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4056!$acc loop seq
4057# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4058#elif defined(MFC_OpenMP)
4059# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4060
4061# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4062#endif
4063 do i = 1, v_size
4064 ! reconstruct from left side
4065
4066 alpha(:) = 0._wp
4067
4068 vp0 = v_rs_weno(j, k, l, i)
4069 vm1 = v_rs_weno(j, k - 1, l, i)
4070 vm2 = v_rs_weno(j, k - 2, l, i)
4071 vp1 = v_rs_weno(j, k + 1, l, i)
4072 vp2 = v_rs_weno(j, k + 2, l, i)
4073
4074 dvd(1) = vp2 - vp1
4075 dvd(0) = vp1 - vp0
4076 dvd(-1) = vp0 - vm1
4077 dvd(-2) = vm1 - vm2
4078
4079 poly(0) = vp0 + poly_coef_cbl_y(k, 0, &
4080 & 0)*dvd(1) + poly_coef_cbl_y(k, 0, 1)*dvd(0)
4081 poly(1) = vp0 + poly_coef_cbl_y(k, 1, &
4082 & 0)*dvd(0) + poly_coef_cbl_y(k, 1, 1)*dvd(-1)
4083 poly(2) = vp0 + poly_coef_cbl_y(k, 2, &
4084 & 0)*dvd(-1) + poly_coef_cbl_y(k, 2, 1)*dvd(-2)
4085
4086 if (uniform_grid(2)) then
4087 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4088 & + weno_eps
4089 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4090 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4091 & + weno_eps
4092 else
4093 beta(0) = beta_coef_y(k, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4094 & 0, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 2)*dvd(0)*dvd(0) + weno_eps
4095 beta(1) = beta_coef_y(k, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4096 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, &
4097 & 2)*dvd(-1)*dvd(-1) + weno_eps
4098 beta(2) = beta_coef_y(k, 2, &
4099 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4100 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4101 end if
4102
4103 if (wenojs) then
4104 do q = 0, weno_num_stencils
4105 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4106 end do
4107 else if (mapped_weno) then
4108 do q = 0, weno_num_stencils
4109 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4110 end do
4111 omega = alpha/sum(alpha)
4112 do q = 0, weno_num_stencils
4113 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4114 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4115 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4116 end do
4117 else if (wenoz) then
4118 ! Borges, et al. (2008)
4119
4120 tau = abs(beta(2) - beta(0)) ! Equation 25
4121
4122# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4123#if defined(MFC_OpenACC)
4124# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4125!$acc loop seq
4126# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4127#elif defined(MFC_OpenMP)
4128# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4129
4130# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4131#endif
4132 do q = 0, weno_num_stencils
4133 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q)))
4134 ! Equation 28 (note: weno_eps was already added to beta)
4135 end do
4136 else if (teno) then
4137 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4138 tau = abs(beta(2) - beta(0))
4139
4140# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4141#if defined(MFC_OpenACC)
4142# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4143!$acc loop seq
4144# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4145#elif defined(MFC_OpenMP)
4146# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4147
4148# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4149#endif
4150 do q = 0, weno_num_stencils
4151 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4152 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4153 alpha(q) = (alpha(q)**3._wp)**2._wp
4154 end do
4155 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4156
4157
4158# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4159#if defined(MFC_OpenACC)
4160# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4161!$acc loop seq
4162# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4163#elif defined(MFC_OpenMP)
4164# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4165
4166# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4167#endif
4168 do q = 0, weno_num_stencils
4169 if (omega(q) < teno_ct) then ! Equation 26
4170 delta(q) = 0._wp
4171 else
4172 delta(q) = 1._wp
4173 end if
4174 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4175 end do
4176 end if
4177
4178 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4179 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4180 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4181
4182 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4183
4184 ! reconstruct from right side
4185
4186 poly(0) = vp0 + poly_coef_cbr_y(k, 0, &
4187 & 0)*dvd(1) + poly_coef_cbr_y(k, 0, 1)*dvd(0)
4188 poly(1) = vp0 + poly_coef_cbr_y(k, 1, &
4189 & 0)*dvd(0) + poly_coef_cbr_y(k, 1, 1)*dvd(-1)
4190 poly(2) = vp0 + poly_coef_cbr_y(k, 2, &
4191 & 0)*dvd(-1) + poly_coef_cbr_y(k, 2, 1)*dvd(-2)
4192
4193 if (wenojs) then
4194 do q = 0, weno_num_stencils
4195 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4196 end do
4197 else if (mapped_weno) then
4198 do q = 0, weno_num_stencils
4199 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4200 end do
4201 omega = alpha/sum(alpha)
4202 do q = 0, weno_num_stencils
4203 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4204 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4205 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4206 end do
4207 else if (wenoz) then
4208
4209# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4210#if defined(MFC_OpenACC)
4211# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4212!$acc loop seq
4213# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4214#elif defined(MFC_OpenMP)
4215# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4216
4217# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4218#endif
4219 do q = 0, weno_num_stencils
4220 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q)))
4221 end do
4222 else if (teno) then
4223
4224# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4225#if defined(MFC_OpenACC)
4226# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4227!$acc loop seq
4228# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4229#elif defined(MFC_OpenMP)
4230# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4231
4232# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4233#endif
4234 do q = 0, weno_num_stencils
4235 alpha(q) = delta(q)*d_cbr_y(q, k)
4236 end do
4237 end if
4238
4239 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4240 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4241 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4242
4243 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4244 end do
4245 end do
4246 end do
4247 end do
4248
4249# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4250#if defined(MFC_OpenACC)
4251# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4252!$acc end parallel loop
4253# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4254#elif defined(MFC_OpenMP)
4255# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4256
4257# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4258!$omp end target teams loop
4259# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4260#endif
4261
4262 if (mp_weno) then
4263 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4264 end if
4265 end if
4266# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4267# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4268# 1097 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4269 if (weno_dir == 3) then
4270
4271# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4272
4273# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4274#if defined(MFC_OpenACC)
4275# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4276!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4277# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4278#elif defined(MFC_OpenMP)
4279# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4280
4281# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4282
4283# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4284
4285# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4286!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4287# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4288!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4289# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4290#endif
4291# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4292 do l = is1_weno%beg, is1_weno%end
4293 do k = is2_weno%beg, is2_weno%end
4294 do j = is3_weno%beg, is3_weno%end
4295
4296# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4297#if defined(MFC_OpenACC)
4298# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4299!$acc loop seq
4300# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4301#elif defined(MFC_OpenMP)
4302# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4303
4304# 1103 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4305#endif
4306 do i = 1, v_size
4307 ! reconstruct from left side
4308
4309 alpha(:) = 0._wp
4310
4311 vp0 = v_rs_weno(j, k, l, i)
4312 vm1 = v_rs_weno(j, k, l - 1, i)
4313 vm2 = v_rs_weno(j, k, l - 2, i)
4314 vp1 = v_rs_weno(j, k, l + 1, i)
4315 vp2 = v_rs_weno(j, k, l + 2, i)
4316
4317 dvd(1) = vp2 - vp1
4318 dvd(0) = vp1 - vp0
4319 dvd(-1) = vp0 - vm1
4320 dvd(-2) = vm1 - vm2
4321
4322 poly(0) = vp0 + poly_coef_cbl_z(l, 0, &
4323 & 0)*dvd(1) + poly_coef_cbl_z(l, 0, 1)*dvd(0)
4324 poly(1) = vp0 + poly_coef_cbl_z(l, 1, &
4325 & 0)*dvd(0) + poly_coef_cbl_z(l, 1, 1)*dvd(-1)
4326 poly(2) = vp0 + poly_coef_cbl_z(l, 2, &
4327 & 0)*dvd(-1) + poly_coef_cbl_z(l, 2, 1)*dvd(-2)
4328
4329 if (uniform_grid(3)) then
4330 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4331 & + weno_eps
4332 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4333 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4334 & + weno_eps
4335 else
4336 beta(0) = beta_coef_z(l, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
4337 & 0, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 2)*dvd(0)*dvd(0) + weno_eps
4338 beta(1) = beta_coef_z(l, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
4339 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, &
4340 & 2)*dvd(-1)*dvd(-1) + weno_eps
4341 beta(2) = beta_coef_z(l, 2, &
4342 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
4343 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4344 end if
4345
4346 if (wenojs) then
4347 do q = 0, weno_num_stencils
4348 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4349 end do
4350 else if (mapped_weno) then
4351 do q = 0, weno_num_stencils
4352 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4353 end do
4354 omega = alpha/sum(alpha)
4355 do q = 0, weno_num_stencils
4356 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
4357 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
4358 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
4359 end do
4360 else if (wenoz) then
4361 ! Borges, et al. (2008)
4362
4363 tau = abs(beta(2) - beta(0)) ! Equation 25
4364
4365# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4366#if defined(MFC_OpenACC)
4367# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4368!$acc loop seq
4369# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4370#elif defined(MFC_OpenMP)
4371# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4372
4373# 1162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4374#endif
4375 do q = 0, weno_num_stencils
4376 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q)))
4377 ! Equation 28 (note: weno_eps was already added to beta)
4378 end do
4379 else if (teno) then
4380 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4381 tau = abs(beta(2) - beta(0))
4382
4383# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4384#if defined(MFC_OpenACC)
4385# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4386!$acc loop seq
4387# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4388#elif defined(MFC_OpenMP)
4389# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4390
4391# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4392#endif
4393 do q = 0, weno_num_stencils
4394 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4395 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4396 alpha(q) = (alpha(q)**3._wp)**2._wp
4397 end do
4398 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4399
4400
4401# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4402#if defined(MFC_OpenACC)
4403# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4404!$acc loop seq
4405# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4406#elif defined(MFC_OpenMP)
4407# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4408
4409# 1178 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4410#endif
4411 do q = 0, weno_num_stencils
4412 if (omega(q) < teno_ct) then ! Equation 26
4413 delta(q) = 0._wp
4414 else
4415 delta(q) = 1._wp
4416 end if
4417 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
4418 end do
4419 end if
4420
4421 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4422 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4423 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4424
4425 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4426
4427 ! reconstruct from right side
4428
4429 poly(0) = vp0 + poly_coef_cbr_z(l, 0, &
4430 & 0)*dvd(1) + poly_coef_cbr_z(l, 0, 1)*dvd(0)
4431 poly(1) = vp0 + poly_coef_cbr_z(l, 1, &
4432 & 0)*dvd(0) + poly_coef_cbr_z(l, 1, 1)*dvd(-1)
4433 poly(2) = vp0 + poly_coef_cbr_z(l, 2, &
4434 & 0)*dvd(-1) + poly_coef_cbr_z(l, 2, 1)*dvd(-2)
4435
4436 if (wenojs) then
4437 do q = 0, weno_num_stencils
4438 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4439 end do
4440 else if (mapped_weno) then
4441 do q = 0, weno_num_stencils
4442 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4443 end do
4444 omega = alpha/sum(alpha)
4445 do q = 0, weno_num_stencils
4446 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
4447 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
4448 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
4449 end do
4450 else if (wenoz) then
4451
4452# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4453#if defined(MFC_OpenACC)
4454# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4455!$acc loop seq
4456# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4457#elif defined(MFC_OpenMP)
4458# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4459
4460# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4461#endif
4462 do q = 0, weno_num_stencils
4463 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q)))
4464 end do
4465 else if (teno) then
4466
4467# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4468#if defined(MFC_OpenACC)
4469# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4470!$acc loop seq
4471# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4472#elif defined(MFC_OpenMP)
4473# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4474
4475# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4476#endif
4477 do q = 0, weno_num_stencils
4478 alpha(q) = delta(q)*d_cbr_z(q, l)
4479 end do
4480 end if
4481
4482 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4483 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4484 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4485
4486 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4487 end do
4488 end do
4489 end do
4490 end do
4491
4492# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4493#if defined(MFC_OpenACC)
4494# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4495!$acc end parallel loop
4496# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4497#elif defined(MFC_OpenMP)
4498# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4499
4500# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4501!$omp end target teams loop
4502# 1239 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4503#endif
4504
4505 if (mp_weno) then
4506 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4507 end if
4508 end if
4509# 1246 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4510# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4511 end if
4512 if (weno_order == 7) then
4513# 1250 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4514# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4515# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4516# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4517 if (weno_dir == 1) then
4518
4519# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4520
4521# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4522#if defined(MFC_OpenACC)
4523# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4524!$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)
4525# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4526#elif defined(MFC_OpenMP)
4527# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4528
4529# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4530
4531# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4532
4533# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4534!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4535# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4536!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4537# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4538#endif
4539# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4540 do l = is3_weno%beg, is3_weno%end
4541 do k = is2_weno%beg, is2_weno%end
4542 do j = is1_weno%beg, is1_weno%end
4543
4544# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4545#if defined(MFC_OpenACC)
4546# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4547!$acc loop seq
4548# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4549#elif defined(MFC_OpenMP)
4550# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4551
4552# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4553#endif
4554 do i = 1, v_size
4555 alpha(:) = 0._wp
4556
4557 vp0 = v_rs_weno(j, k, l, i)
4558 vm1 = v_rs_weno(j - 1, k, l, i)
4559 vm2 = v_rs_weno(j - 2, k, l, i)
4560 vm3 = v_rs_weno(j - 3, k, l, i)
4561 vp1 = v_rs_weno(j + 1, k, l, i)
4562 vp2 = v_rs_weno(j + 2, k, l, i)
4563 vp3 = v_rs_weno(j + 3, k, l, i)
4564
4565 if (teno) then
4566 v(-3) = vm3
4567 v(-2) = vm2
4568 v(-1) = vm1
4569 v(0) = vp0
4570 v(1) = vp1
4571 v(2) = vp2
4572 v(3) = vp3
4573 end if
4574
4575 if (.not. teno) then
4576 dvd(2) = vp3 - vp2
4577 dvd(1) = vp2 - vp1
4578 dvd(0) = vp1 - vp0
4579 dvd(-1) = vp0 - vm1
4580 dvd(-2) = vm1 - vm2
4581 dvd(-3) = vm2 - vm3
4582
4583 poly(3) = vp0 + poly_coef_cbl_x(j, 0, &
4584 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, &
4585 & 1)*dvd(1) + poly_coef_cbl_x(j, 0, 2)*dvd(0)
4586 poly(2) = vp0 + poly_coef_cbl_x(j, 1, &
4587 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, &
4588 & 1)*dvd(0) + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
4589 poly(1) = vp0 + poly_coef_cbl_x(j, 2, &
4590 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4591 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4592 poly(0) = vp0 + poly_coef_cbl_x(j, 3, &
4593 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4594 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4595 else
4596# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4597 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4598 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4599 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4600 ! to keep the stencil order to reuse the beta coefficients
4601 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4602 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4603 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4604 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4605 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4606# 1316 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4607 end if
4608
4609 if (.not. teno) then
4610 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, &
4611 & 0, 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4612 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4613 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4614 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4615
4616 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
4617 & 1, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4618 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4619 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4620 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4621
4622 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
4623 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4624 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4625 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4626 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4627
4628 beta(0) = beta_coef_x(j, 3, &
4629 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4630 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4631 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4632 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4633 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4634 else
4635# 1345 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4636 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4637 ! & Tang, 2019) Section 3.2
4638 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4639 & **2._wp)/4._wp + weno_eps
4640 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4641 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4642 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4643 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4644
4645 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4646 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4647 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4648
4649 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4650 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4651 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4652# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4653 end if
4654
4655 if (wenojs) then
4656 do q = 0, weno_num_stencils
4657 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4658 end do
4659 else if (mapped_weno) then
4660 do q = 0, weno_num_stencils
4661 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4662 end do
4663 omega = alpha/sum(alpha)
4664 do q = 0, weno_num_stencils
4665 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
4666 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
4667 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
4668 end do
4669 else if (wenoz) then
4670 ! Castro, et al. (2010) Don & Borges (2013) also helps
4671 tau = abs(beta(3) - beta(0)) ! Equation 50
4672
4673# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4674#if defined(MFC_OpenACC)
4675# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4676!$acc loop seq
4677# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4678#elif defined(MFC_OpenMP)
4679# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4680
4681# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4682#endif
4683 do q = 0, weno_num_stencils
4684 ! wenoz_q = 2,3,4 for stability
4685 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4686 end do
4687 else if (teno) then
4688# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4689 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4690 alpha = 1._wp + tau/beta
4691 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4692 omega = alpha/sum(alpha)
4693
4694
4695# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4696#if defined(MFC_OpenACC)
4697# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4698!$acc loop seq
4699# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4700#elif defined(MFC_OpenMP)
4701# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4702
4703# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4704#endif
4705 do q = 0, weno_num_stencils
4706 if (omega(q) < teno_ct) then ! Equation 26
4707 delta(q) = 0._wp
4708 else
4709 delta(q) = 1._wp
4710 end if
4711 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4712 end do
4713# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4714 end if
4715
4716 omega = alpha/sum(alpha)
4717
4718 vl_rs_vf_x(j, k, l, &
4719 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4720
4721 if (teno) then
4722# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4723 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4724# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4725 end if
4726
4727 if (.not. teno) then
4728 poly(3) = vp0 + poly_coef_cbr_x(j, 0, &
4729 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, &
4730 & 1)*dvd(1) + poly_coef_cbr_x(j, 0, 2)*dvd(0)
4731 poly(2) = vp0 + poly_coef_cbr_x(j, 1, &
4732 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, &
4733 & 1)*dvd(0) + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
4734 poly(1) = vp0 + poly_coef_cbr_x(j, 2, &
4735 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4736 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4737 poly(0) = vp0 + poly_coef_cbr_x(j, 3, &
4738 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4739 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4740 else
4741# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4742 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4743 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4744 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4745 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4746 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4747# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4748 end if
4749
4750 if (wenojs) then
4751 do q = 0, weno_num_stencils
4752 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4753 end do
4754 else if (mapped_weno) then
4755 do q = 0, weno_num_stencils
4756 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4757 end do
4758 omega = alpha/sum(alpha)
4759 do q = 0, weno_num_stencils
4760 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
4761 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
4762 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
4763 end do
4764 else if (wenoz) then
4765
4766# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4767#if defined(MFC_OpenACC)
4768# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4769!$acc loop seq
4770# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4771#elif defined(MFC_OpenMP)
4772# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4773
4774# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4775#endif
4776 do q = 0, weno_num_stencils
4777 ! wenoz_q = 2,3,4 for stability
4778 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4779 end do
4780 else if (teno) then
4781
4782# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4783#if defined(MFC_OpenACC)
4784# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4785!$acc loop seq
4786# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4787#elif defined(MFC_OpenMP)
4788# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4789
4790# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4791#endif
4792 do q = 0, weno_num_stencils
4793 alpha(q) = delta(q)*d_cbr_x(q, j)
4794 end do
4795 end if
4796
4797 omega = alpha/sum(alpha)
4798
4799 vr_rs_vf_x(j, k, l, &
4800 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4801
4802 if (teno) then
4803# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4804 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4805# 1475 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4806 end if
4807 end do
4808 end do
4809 end do
4810 end do
4811
4812# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4813#if defined(MFC_OpenACC)
4814# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4815!$acc end parallel loop
4816# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4817#elif defined(MFC_OpenMP)
4818# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4819
4820# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4821!$omp end target teams loop
4822# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4823#endif
4824 end if
4825# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4826# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4827# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4828 if (weno_dir == 2) then
4829
4830# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4831
4832# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4833#if defined(MFC_OpenACC)
4834# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4835!$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)
4836# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4837#elif defined(MFC_OpenMP)
4838# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4839
4840# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4841
4842# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4843
4844# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4845!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4846# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4847!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4848# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4849#endif
4850# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4851 do l = is3_weno%beg, is3_weno%end
4852 do k = is1_weno%beg, is1_weno%end
4853 do j = is2_weno%beg, is2_weno%end
4854
4855# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4856#if defined(MFC_OpenACC)
4857# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4858!$acc loop seq
4859# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4860#elif defined(MFC_OpenMP)
4861# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4862
4863# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4864#endif
4865 do i = 1, v_size
4866 alpha(:) = 0._wp
4867
4868 vp0 = v_rs_weno(j, k, l, i)
4869 vm1 = v_rs_weno(j, k - 1, l, i)
4870 vm2 = v_rs_weno(j, k - 2, l, i)
4871 vm3 = v_rs_weno(j, k - 3, l, i)
4872 vp1 = v_rs_weno(j, k + 1, l, i)
4873 vp2 = v_rs_weno(j, k + 2, l, i)
4874 vp3 = v_rs_weno(j, k + 3, l, i)
4875
4876 if (teno) then
4877 v(-3) = vm3
4878 v(-2) = vm2
4879 v(-1) = vm1
4880 v(0) = vp0
4881 v(1) = vp1
4882 v(2) = vp2
4883 v(3) = vp3
4884 end if
4885
4886 if (.not. teno) then
4887 dvd(2) = vp3 - vp2
4888 dvd(1) = vp2 - vp1
4889 dvd(0) = vp1 - vp0
4890 dvd(-1) = vp0 - vm1
4891 dvd(-2) = vm1 - vm2
4892 dvd(-3) = vm2 - vm3
4893
4894 poly(3) = vp0 + poly_coef_cbl_y(k, 0, &
4895 & 0)*dvd(2) + poly_coef_cbl_y(k, 0, &
4896 & 1)*dvd(1) + poly_coef_cbl_y(k, 0, 2)*dvd(0)
4897 poly(2) = vp0 + poly_coef_cbl_y(k, 1, &
4898 & 0)*dvd(1) + poly_coef_cbl_y(k, 1, &
4899 & 1)*dvd(0) + poly_coef_cbl_y(k, 1, 2)*dvd(-1)
4900 poly(1) = vp0 + poly_coef_cbl_y(k, 2, &
4901 & 0)*dvd(0) + poly_coef_cbl_y(k, 2, &
4902 & 1)*dvd(-1) + poly_coef_cbl_y(k, 2, 2)*dvd(-2)
4903 poly(0) = vp0 + poly_coef_cbl_y(k, 3, &
4904 & 0)*dvd(-1) + poly_coef_cbl_y(k, 3, &
4905 & 1)*dvd(-2) + poly_coef_cbl_y(k, 3, 2)*dvd(-3)
4906 else
4907# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4908 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4909 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4910 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4911 ! to keep the stencil order to reuse the beta coefficients
4912 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4913 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4914 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4915 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4916 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4917# 1316 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4918 end if
4919
4920 if (.not. teno) then
4921 beta(3) = beta_coef_y(k, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(k, &
4922 & 0, 1)*dvd(2)*dvd(1) + beta_coef_y(k, 0, &
4923 & 2)*dvd(2)*dvd(0) + beta_coef_y(k, 0, &
4924 & 3)*dvd(1)*dvd(1) + beta_coef_y(k, 0, &
4925 & 4)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 5)*dvd(0)*dvd(0) + weno_eps
4926
4927 beta(2) = beta_coef_y(k, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4928 & 1, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 1, &
4929 & 2)*dvd(1)*dvd(-1) + beta_coef_y(k, 1, &
4930 & 3)*dvd(0)*dvd(0) + beta_coef_y(k, 1, &
4931 & 4)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4932
4933 beta(1) = beta_coef_y(k, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4934 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 2, &
4935 & 2)*dvd(0)*dvd(-2) + beta_coef_y(k, 2, &
4936 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4937 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4938
4939 beta(0) = beta_coef_y(k, 3, &
4940 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 3, &
4941 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 3, &
4942 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(k, 3, &
4943 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(k, 3, &
4944 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(k, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4945 else
4946# 1345 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4947 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4948 ! & Tang, 2019) Section 3.2
4949 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4950 & **2._wp)/4._wp + weno_eps
4951 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4952 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4953 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4954 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4955
4956 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4957 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4958 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4959
4960 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4961 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4962 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4963# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4964 end if
4965
4966 if (wenojs) then
4967 do q = 0, weno_num_stencils
4968 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4969 end do
4970 else if (mapped_weno) then
4971 do q = 0, weno_num_stencils
4972 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4973 end do
4974 omega = alpha/sum(alpha)
4975 do q = 0, weno_num_stencils
4976 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4977 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4978 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4979 end do
4980 else if (wenoz) then
4981 ! Castro, et al. (2010) Don & Borges (2013) also helps
4982 tau = abs(beta(3) - beta(0)) ! Equation 50
4983
4984# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4985#if defined(MFC_OpenACC)
4986# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4987!$acc loop seq
4988# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4989#elif defined(MFC_OpenMP)
4990# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4991
4992# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4993#endif
4994 do q = 0, weno_num_stencils
4995 ! wenoz_q = 2,3,4 for stability
4996 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
4997 end do
4998 else if (teno) then
4999# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5000 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5001 alpha = 1._wp + tau/beta
5002 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5003 omega = alpha/sum(alpha)
5004
5005
5006# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5007#if defined(MFC_OpenACC)
5008# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5009!$acc loop seq
5010# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5011#elif defined(MFC_OpenMP)
5012# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5013
5014# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5015#endif
5016 do q = 0, weno_num_stencils
5017 if (omega(q) < teno_ct) then ! Equation 26
5018 delta(q) = 0._wp
5019 else
5020 delta(q) = 1._wp
5021 end if
5022 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
5023 end do
5024# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5025 end if
5026
5027 omega = alpha/sum(alpha)
5028
5029 vl_rs_vf_x(j, k, l, &
5030 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5031
5032 if (teno) then
5033# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5034 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5035# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5036 end if
5037
5038 if (.not. teno) then
5039 poly(3) = vp0 + poly_coef_cbr_y(k, 0, &
5040 & 0)*dvd(2) + poly_coef_cbr_y(k, 0, &
5041 & 1)*dvd(1) + poly_coef_cbr_y(k, 0, 2)*dvd(0)
5042 poly(2) = vp0 + poly_coef_cbr_y(k, 1, &
5043 & 0)*dvd(1) + poly_coef_cbr_y(k, 1, &
5044 & 1)*dvd(0) + poly_coef_cbr_y(k, 1, 2)*dvd(-1)
5045 poly(1) = vp0 + poly_coef_cbr_y(k, 2, &
5046 & 0)*dvd(0) + poly_coef_cbr_y(k, 2, &
5047 & 1)*dvd(-1) + poly_coef_cbr_y(k, 2, 2)*dvd(-2)
5048 poly(0) = vp0 + poly_coef_cbr_y(k, 3, &
5049 & 0)*dvd(-1) + poly_coef_cbr_y(k, 3, &
5050 & 1)*dvd(-2) + poly_coef_cbr_y(k, 3, 2)*dvd(-3)
5051 else
5052# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5053 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5054 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5055 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5056 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5057 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5058# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5059 end if
5060
5061 if (wenojs) then
5062 do q = 0, weno_num_stencils
5063 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
5064 end do
5065 else if (mapped_weno) then
5066 do q = 0, weno_num_stencils
5067 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
5068 end do
5069 omega = alpha/sum(alpha)
5070 do q = 0, weno_num_stencils
5071 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
5072 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
5073 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
5074 end do
5075 else if (wenoz) then
5076
5077# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5078#if defined(MFC_OpenACC)
5079# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5080!$acc loop seq
5081# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5082#elif defined(MFC_OpenMP)
5083# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5084
5085# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5086#endif
5087 do q = 0, weno_num_stencils
5088 ! wenoz_q = 2,3,4 for stability
5089 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
5090 end do
5091 else if (teno) then
5092
5093# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5094#if defined(MFC_OpenACC)
5095# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5096!$acc loop seq
5097# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5098#elif defined(MFC_OpenMP)
5099# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5100
5101# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5102#endif
5103 do q = 0, weno_num_stencils
5104 alpha(q) = delta(q)*d_cbr_y(q, k)
5105 end do
5106 end if
5107
5108 omega = alpha/sum(alpha)
5109
5110 vr_rs_vf_x(j, k, l, &
5111 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5112
5113 if (teno) then
5114# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5115 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5116# 1475 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5117 end if
5118 end do
5119 end do
5120 end do
5121 end do
5122
5123# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5124#if defined(MFC_OpenACC)
5125# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5126!$acc end parallel loop
5127# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5128#elif defined(MFC_OpenMP)
5129# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5130
5131# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5132!$omp end target teams loop
5133# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5134#endif
5135 end if
5136# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5137# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5138# 1256 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5139 if (weno_dir == 3) then
5140
5141# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5142
5143# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5144#if defined(MFC_OpenACC)
5145# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5146!$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)
5147# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5148#elif defined(MFC_OpenMP)
5149# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5150
5151# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5152
5153# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5154
5155# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5156!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5157# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5158!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5159# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5160#endif
5161# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5162 do l = is1_weno%beg, is1_weno%end
5163 do k = is2_weno%beg, is2_weno%end
5164 do j = is3_weno%beg, is3_weno%end
5165
5166# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5167#if defined(MFC_OpenACC)
5168# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5169!$acc loop seq
5170# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5171#elif defined(MFC_OpenMP)
5172# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5173
5174# 1262 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5175#endif
5176 do i = 1, v_size
5177 alpha(:) = 0._wp
5178
5179 vp0 = v_rs_weno(j, k, l, i)
5180 vm1 = v_rs_weno(j, k, l - 1, i)
5181 vm2 = v_rs_weno(j, k, l - 2, i)
5182 vm3 = v_rs_weno(j, k, l - 3, i)
5183 vp1 = v_rs_weno(j, k, l + 1, i)
5184 vp2 = v_rs_weno(j, k, l + 2, i)
5185 vp3 = v_rs_weno(j, k, l + 3, i)
5186
5187 if (teno) then
5188 v(-3) = vm3
5189 v(-2) = vm2
5190 v(-1) = vm1
5191 v(0) = vp0
5192 v(1) = vp1
5193 v(2) = vp2
5194 v(3) = vp3
5195 end if
5196
5197 if (.not. teno) then
5198 dvd(2) = vp3 - vp2
5199 dvd(1) = vp2 - vp1
5200 dvd(0) = vp1 - vp0
5201 dvd(-1) = vp0 - vm1
5202 dvd(-2) = vm1 - vm2
5203 dvd(-3) = vm2 - vm3
5204
5205 poly(3) = vp0 + poly_coef_cbl_z(l, 0, &
5206 & 0)*dvd(2) + poly_coef_cbl_z(l, 0, &
5207 & 1)*dvd(1) + poly_coef_cbl_z(l, 0, 2)*dvd(0)
5208 poly(2) = vp0 + poly_coef_cbl_z(l, 1, &
5209 & 0)*dvd(1) + poly_coef_cbl_z(l, 1, &
5210 & 1)*dvd(0) + poly_coef_cbl_z(l, 1, 2)*dvd(-1)
5211 poly(1) = vp0 + poly_coef_cbl_z(l, 2, &
5212 & 0)*dvd(0) + poly_coef_cbl_z(l, 2, &
5213 & 1)*dvd(-1) + poly_coef_cbl_z(l, 2, 2)*dvd(-2)
5214 poly(0) = vp0 + poly_coef_cbl_z(l, 3, &
5215 & 0)*dvd(-1) + poly_coef_cbl_z(l, 3, &
5216 & 1)*dvd(-2) + poly_coef_cbl_z(l, 3, 2)*dvd(-3)
5217 else
5218# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
5220 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
5221 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
5222 ! to keep the stencil order to reuse the beta coefficients
5223 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
5224 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
5225 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
5226 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
5227 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
5228# 1316 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5229 end if
5230
5231 if (.not. teno) then
5232 beta(3) = beta_coef_z(l, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(l, &
5233 & 0, 1)*dvd(2)*dvd(1) + beta_coef_z(l, 0, &
5234 & 2)*dvd(2)*dvd(0) + beta_coef_z(l, 0, &
5235 & 3)*dvd(1)*dvd(1) + beta_coef_z(l, 0, &
5236 & 4)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 5)*dvd(0)*dvd(0) + weno_eps
5237
5238 beta(2) = beta_coef_z(l, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
5239 & 1, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 1, &
5240 & 2)*dvd(1)*dvd(-1) + beta_coef_z(l, 1, &
5241 & 3)*dvd(0)*dvd(0) + beta_coef_z(l, 1, &
5242 & 4)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
5243
5244 beta(1) = beta_coef_z(l, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
5245 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 2, &
5246 & 2)*dvd(0)*dvd(-2) + beta_coef_z(l, 2, &
5247 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
5248 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
5249
5250 beta(0) = beta_coef_z(l, 3, &
5251 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 3, &
5252 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 3, &
5253 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(l, 3, &
5254 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(l, 3, &
5255 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(l, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5256 else
5257# 1345 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5258 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5259 ! & Tang, 2019) Section 3.2
5260 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5261 & **2._wp)/4._wp + weno_eps
5262 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5263 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5264 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5265 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5266
5267 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5268 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5269 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5270
5271 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5272 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5273 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5274# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5275 end if
5276
5277 if (wenojs) then
5278 do q = 0, weno_num_stencils
5279 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5280 end do
5281 else if (mapped_weno) then
5282 do q = 0, weno_num_stencils
5283 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5284 end do
5285 omega = alpha/sum(alpha)
5286 do q = 0, weno_num_stencils
5287 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
5288 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
5289 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
5290 end do
5291 else if (wenoz) then
5292 ! Castro, et al. (2010) Don & Borges (2013) also helps
5293 tau = abs(beta(3) - beta(0)) ! Equation 50
5294
5295# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5296#if defined(MFC_OpenACC)
5297# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5298!$acc loop seq
5299# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5300#elif defined(MFC_OpenMP)
5301# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5302
5303# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5304#endif
5305 do q = 0, weno_num_stencils
5306 ! wenoz_q = 2,3,4 for stability
5307 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5308 end do
5309 else if (teno) then
5310# 1388 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5311 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5312 alpha = 1._wp + tau/beta
5313 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5314 omega = alpha/sum(alpha)
5315
5316
5317# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5318#if defined(MFC_OpenACC)
5319# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5320!$acc loop seq
5321# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5322#elif defined(MFC_OpenMP)
5323# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5324
5325# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5326#endif
5327 do q = 0, weno_num_stencils
5328 if (omega(q) < teno_ct) then ! Equation 26
5329 delta(q) = 0._wp
5330 else
5331 delta(q) = 1._wp
5332 end if
5333 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
5334 end do
5335# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5336 end if
5337
5338 omega = alpha/sum(alpha)
5339
5340 vl_rs_vf_x(j, k, l, &
5341 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5342
5343 if (teno) then
5344# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5345 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5346# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5347 end if
5348
5349 if (.not. teno) then
5350 poly(3) = vp0 + poly_coef_cbr_z(l, 0, &
5351 & 0)*dvd(2) + poly_coef_cbr_z(l, 0, &
5352 & 1)*dvd(1) + poly_coef_cbr_z(l, 0, 2)*dvd(0)
5353 poly(2) = vp0 + poly_coef_cbr_z(l, 1, &
5354 & 0)*dvd(1) + poly_coef_cbr_z(l, 1, &
5355 & 1)*dvd(0) + poly_coef_cbr_z(l, 1, 2)*dvd(-1)
5356 poly(1) = vp0 + poly_coef_cbr_z(l, 2, &
5357 & 0)*dvd(0) + poly_coef_cbr_z(l, 2, &
5358 & 1)*dvd(-1) + poly_coef_cbr_z(l, 2, 2)*dvd(-2)
5359 poly(0) = vp0 + poly_coef_cbr_z(l, 3, &
5360 & 0)*dvd(-1) + poly_coef_cbr_z(l, 3, &
5361 & 1)*dvd(-2) + poly_coef_cbr_z(l, 3, 2)*dvd(-3)
5362 else
5363# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5364 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5365 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5366 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5367 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5368 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5369# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5370 end if
5371
5372 if (wenojs) then
5373 do q = 0, weno_num_stencils
5374 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5375 end do
5376 else if (mapped_weno) then
5377 do q = 0, weno_num_stencils
5378 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5379 end do
5380 omega = alpha/sum(alpha)
5381 do q = 0, weno_num_stencils
5382 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
5383 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
5384 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
5385 end do
5386 else if (wenoz) then
5387
5388# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5389#if defined(MFC_OpenACC)
5390# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5391!$acc loop seq
5392# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5393#elif defined(MFC_OpenMP)
5394# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5395
5396# 1454 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5397#endif
5398 do q = 0, weno_num_stencils
5399 ! wenoz_q = 2,3,4 for stability
5400 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5401 end do
5402 else if (teno) then
5403
5404# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5405#if defined(MFC_OpenACC)
5406# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5407!$acc loop seq
5408# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5409#elif defined(MFC_OpenMP)
5410# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5411
5412# 1460 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5413#endif
5414 do q = 0, weno_num_stencils
5415 alpha(q) = delta(q)*d_cbr_z(q, l)
5416 end do
5417 end if
5418
5419 omega = alpha/sum(alpha)
5420
5421 vr_rs_vf_x(j, k, l, &
5422 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5423
5424 if (teno) then
5425# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5426 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5427# 1475 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5428 end if
5429 end do
5430 end do
5431 end do
5432 end do
5433
5434# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5435#if defined(MFC_OpenACC)
5436# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5437!$acc end parallel loop
5438# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5439#elif defined(MFC_OpenMP)
5440# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5441
5442# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5443!$omp end target teams loop
5444# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5445#endif
5446 end if
5447# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5448# 1484 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5449 end if
5450
5451 if (int_comp > 0 .and. v_size >= eqn_idx%adv%end) then
5452 call nvtxstartrange("WENO-INTCOMP")
5453 call s_thinc_compression(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno, is2_weno, is3_weno)
5454 call nvtxendrange()
5455 end if
5456
5457 end subroutine s_weno
5458
5459 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5460 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf, weno_dir)
5461
5462 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5463 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5464 integer, intent(in) :: weno_dir
5465 integer :: i, j, k, l
5466 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5467 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5468 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5469 ! the cell- average variables.
5470 real(wp) :: vL_UL, vR_UL
5471 real(wp) :: vL_MD, vR_MD
5472 real(wp) :: vL_LC, vR_LC
5473 real(wp) :: vL_min, vR_min
5474 real(wp) :: vL_max, vR_max
5475 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5476 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5477 real(wp), parameter :: alpha_mp = 2._wp
5478 real(wp), parameter :: beta_mp = 4._wp/3._wp
5479 real(wp) :: vp0, vp1, vp2, vm1, vm2
5480
5481# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5482# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5483# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5484 if (weno_dir == 1) then
5485
5486# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5487
5488# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5489#if defined(MFC_OpenACC)
5490# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5491!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5492# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5493#elif defined(MFC_OpenMP)
5494# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5495
5496# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5497
5498# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5499
5500# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5501!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5502# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5503!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5504# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5505#endif
5506 do l = is3_weno%beg, is3_weno%end
5507 do k = is2_weno%beg, is2_weno%end
5508 do j = is1_weno%beg, is1_weno%end
5509 do i = 1, v_size
5510 ! Second-order undivided differences for curvature estimation
5511
5512 vp0 = v_rs_ws(j, k, l, i)
5513 vm1 = v_rs_ws(j - 1, k, l, i)
5514 vm2 = v_rs_ws(j - 2, k, l, i)
5515 vp1 = v_rs_ws(j + 1, k, l, i)
5516 vp2 = v_rs_ws(j + 2, k, l, i)
5517
5518 d(-1) = vp0 + vm2 - vm1*2._wp
5519 d(0) = vp1 + vm1 - vp0*2._wp
5520 d(1) = vp2 + vp0 - vp1*2._wp
5521
5522 ! Median function for oscillation detection
5523 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5524 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5525 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5526 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5527
5528 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5529 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5530 & 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
5531
5532 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5533
5534 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5535
5536 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5537
5538 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5539
5540 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5541
5542 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, &
5543 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5544 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5545 ! END: Left Monotonicity Preserving Bound
5546
5547 ! Right Monotonicity Preserving Bound
5548 d(-1) = vp0 + vm2 - vm1*2._wp
5549 d(0) = vp1 + vm1 - vp0*2._wp
5550 d(1) = vp2 + vp0 - vp1*2._wp
5551
5552 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5553 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5554 & 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
5555
5556 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5557 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5558 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5559 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5560
5561 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5562
5563 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5564
5565 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5566
5567 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5568
5569 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5570
5571 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, &
5572 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5573 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5574 ! END: Right Monotonicity Preserving Bound
5575 end do
5576 end do
5577 end do
5578 end do
5579
5580# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5581#if defined(MFC_OpenACC)
5582# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5583!$acc end parallel loop
5584# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5585#elif defined(MFC_OpenMP)
5586# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5587
5588# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5589!$omp end target teams loop
5590# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5591#endif
5592 end if
5593# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5594# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5595# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5596 if (weno_dir == 2) then
5597
5598# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5599
5600# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5601#if defined(MFC_OpenACC)
5602# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5603!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5604# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5605#elif defined(MFC_OpenMP)
5606# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5607
5608# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5609
5610# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5611
5612# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5613!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5614# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5615!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5616# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5617#endif
5618 do l = is3_weno%beg, is3_weno%end
5619 do k = is1_weno%beg, is1_weno%end
5620 do j = is2_weno%beg, is2_weno%end
5621 do i = 1, v_size
5622 ! Second-order undivided differences for curvature estimation
5623
5624 vp0 = v_rs_ws(j, k, l, i)
5625 vm1 = v_rs_ws(j, k - 1, l, i)
5626 vm2 = v_rs_ws(j, k - 2, l, i)
5627 vp1 = v_rs_ws(j, k + 1, l, i)
5628 vp2 = v_rs_ws(j, k + 2, l, i)
5629
5630 d(-1) = vp0 + vm2 - vm1*2._wp
5631 d(0) = vp1 + vm1 - vp0*2._wp
5632 d(1) = vp2 + vp0 - vp1*2._wp
5633
5634 ! Median function for oscillation detection
5635 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5636 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5637 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5638 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5639
5640 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5641 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5642 & 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
5643
5644 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5645
5646 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5647
5648 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5649
5650 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5651
5652 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5653
5654 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, &
5655 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5656 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5657 ! END: Left Monotonicity Preserving Bound
5658
5659 ! Right Monotonicity Preserving Bound
5660 d(-1) = vp0 + vm2 - vm1*2._wp
5661 d(0) = vp1 + vm1 - vp0*2._wp
5662 d(1) = vp2 + vp0 - vp1*2._wp
5663
5664 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5665 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5666 & 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
5667
5668 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5669 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5670 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5671 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5672
5673 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5674
5675 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5676
5677 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5678
5679 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5680
5681 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5682
5683 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, &
5684 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5685 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5686 ! END: Right Monotonicity Preserving Bound
5687 end do
5688 end do
5689 end do
5690 end do
5691
5692# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5693#if defined(MFC_OpenACC)
5694# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5695!$acc end parallel loop
5696# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5697#elif defined(MFC_OpenMP)
5698# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5699
5700# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5701!$omp end target teams loop
5702# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5703#endif
5704 end if
5705# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5706# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5707# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5708 if (weno_dir == 3) then
5709
5710# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5711
5712# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5713#if defined(MFC_OpenACC)
5714# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5715!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5716# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5717#elif defined(MFC_OpenMP)
5718# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5719
5720# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5721
5722# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5723
5724# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5725!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5726# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5727!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5728# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5729#endif
5730 do l = is1_weno%beg, is1_weno%end
5731 do k = is2_weno%beg, is2_weno%end
5732 do j = is3_weno%beg, is3_weno%end
5733 do i = 1, v_size
5734 ! Second-order undivided differences for curvature estimation
5735
5736 vp0 = v_rs_ws(j, k, l, i)
5737 vm1 = v_rs_ws(j, k, l - 1, i)
5738 vm2 = v_rs_ws(j, k, l - 2, i)
5739 vp1 = v_rs_ws(j, k, l + 1, i)
5740 vp2 = v_rs_ws(j, k, l + 2, i)
5741
5742 d(-1) = vp0 + vm2 - vm1*2._wp
5743 d(0) = vp1 + vm1 - vp0*2._wp
5744 d(1) = vp2 + vp0 - vp1*2._wp
5745
5746 ! Median function for oscillation detection
5747 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5748 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5749 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5750 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5751
5752 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5753 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5754 & 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
5755
5756 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5757
5758 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5759
5760 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5761
5762 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5763
5764 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5765
5766 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, &
5767 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5768 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5769 ! END: Left Monotonicity Preserving Bound
5770
5771 ! Right Monotonicity Preserving Bound
5772 d(-1) = vp0 + vm2 - vm1*2._wp
5773 d(0) = vp1 + vm1 - vp0*2._wp
5774 d(1) = vp2 + vp0 - vp1*2._wp
5775
5776 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5777 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5778 & 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
5779
5780 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5781 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5782 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5783 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5784
5785 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5786
5787 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5788
5789 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5790
5791 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5792
5793 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5794
5795 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, &
5796 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5797 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5798 ! END: Right Monotonicity Preserving Bound
5799 end do
5800 end do
5801 end do
5802 end do
5803
5804# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5805#if defined(MFC_OpenACC)
5806# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5807!$acc end parallel loop
5808# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5809#elif defined(MFC_OpenMP)
5810# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5811
5812# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5813!$omp end target teams loop
5814# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5815#endif
5816 end if
5817# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5818
5819 end subroutine s_preserve_monotonicity
5820
5821 !> Module deallocation and/or disassociation procedures
5822 impure subroutine s_finalize_weno_module()
5823
5824 if (weno_order == 1) return
5825
5826 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5827
5828#ifdef MFC_DEBUG
5829# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5830 block
5831# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5832 use iso_fortran_env, only: output_unit
5833# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5834
5835# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5836 print *, 'm_weno.fpp:1610: ', '@:DEALLOCATE(v_rs_weno)'
5837# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5838
5839# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5840 call flush (output_unit)
5841# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5842 end block
5843# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844#endif
5845# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5846
5847# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5848#if defined(MFC_OpenACC)
5849# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5850!$acc exit data delete(v_rs_weno)
5851# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5852#elif defined(MFC_OpenMP)
5853# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5854!$omp target exit data map(release:v_rs_weno)
5855# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5856#endif
5857# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5858 deallocate (v_rs_weno)
5859
5860 ! Deallocating WENO coefficients in x-direction
5861#ifdef MFC_DEBUG
5862# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5863 block
5864# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5865 use iso_fortran_env, only: output_unit
5866# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5867
5868# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5869 print *, 'm_weno.fpp:1613: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5870# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5871
5872# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5873 call flush (output_unit)
5874# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5875 end block
5876# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5877#endif
5878# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879
5880# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5881#if defined(MFC_OpenACC)
5882# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5883!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5884# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5885#elif defined(MFC_OpenMP)
5886# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5887!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5888# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5889#endif
5890# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5891 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5892#ifdef MFC_DEBUG
5893# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5894 block
5895# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5896 use iso_fortran_env, only: output_unit
5897# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5898
5899# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5900 print *, 'm_weno.fpp:1614: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5901# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5902
5903# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5904 call flush (output_unit)
5905# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5906 end block
5907# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5908#endif
5909# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5910
5911# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5912#if defined(MFC_OpenACC)
5913# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5914!$acc exit data delete(d_cbL_x, d_cbR_x)
5915# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5916#elif defined(MFC_OpenMP)
5917# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5918!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5919# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5920#endif
5921# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5922 deallocate (d_cbl_x, d_cbr_x)
5923#ifdef MFC_DEBUG
5924# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5925 block
5926# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5927 use iso_fortran_env, only: output_unit
5928# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5929
5930# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5931 print *, 'm_weno.fpp:1615: ', '@:DEALLOCATE(beta_coef_x)'
5932# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5933
5934# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5935 call flush (output_unit)
5936# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5937 end block
5938# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5939#endif
5940# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5941
5942# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5943#if defined(MFC_OpenACC)
5944# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5945!$acc exit data delete(beta_coef_x)
5946# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5947#elif defined(MFC_OpenMP)
5948# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5949!$omp target exit data map(release:beta_coef_x)
5950# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5951#endif
5952# 1615 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5953 deallocate (beta_coef_x)
5954
5955 ! Deallocating WENO coefficients in y-direction
5956 if (n == 0) return
5957
5958#ifdef MFC_DEBUG
5959# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5960 block
5961# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5962 use iso_fortran_env, only: output_unit
5963# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5964
5965# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5966 print *, 'm_weno.fpp:1620: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5967# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5968
5969# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5970 call flush (output_unit)
5971# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5972 end block
5973# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5974#endif
5975# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5976
5977# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5978#if defined(MFC_OpenACC)
5979# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5980!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5981# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5982#elif defined(MFC_OpenMP)
5983# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5984!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5985# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5986#endif
5987# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5988 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5989#ifdef MFC_DEBUG
5990# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5991 block
5992# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5993 use iso_fortran_env, only: output_unit
5994# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5995
5996# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5997 print *, 'm_weno.fpp:1621: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5998# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5999
6000# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6001 call flush (output_unit)
6002# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6003 end block
6004# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6005#endif
6006# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6007
6008# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6009#if defined(MFC_OpenACC)
6010# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6011!$acc exit data delete(d_cbL_y, d_cbR_y)
6012# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6013#elif defined(MFC_OpenMP)
6014# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6015!$omp target exit data map(release:d_cbL_y, d_cbR_y)
6016# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6017#endif
6018# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6019 deallocate (d_cbl_y, d_cbr_y)
6020#ifdef MFC_DEBUG
6021# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6022 block
6023# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6024 use iso_fortran_env, only: output_unit
6025# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6026
6027# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6028 print *, 'm_weno.fpp:1622: ', '@:DEALLOCATE(beta_coef_y)'
6029# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6030
6031# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6032 call flush (output_unit)
6033# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6034 end block
6035# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6036#endif
6037# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6038
6039# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6040#if defined(MFC_OpenACC)
6041# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6042!$acc exit data delete(beta_coef_y)
6043# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6044#elif defined(MFC_OpenMP)
6045# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6046!$omp target exit data map(release:beta_coef_y)
6047# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6048#endif
6049# 1622 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6050 deallocate (beta_coef_y)
6051
6052 ! Deallocating WENO coefficients in z-direction
6053 if (p == 0) return
6054
6055#ifdef MFC_DEBUG
6056# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6057 block
6058# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6059 use iso_fortran_env, only: output_unit
6060# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6061
6062# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6063 print *, 'm_weno.fpp:1627: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
6064# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6065
6066# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6067 call flush (output_unit)
6068# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6069 end block
6070# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6071#endif
6072# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6073
6074# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6075#if defined(MFC_OpenACC)
6076# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6077!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
6078# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6079#elif defined(MFC_OpenMP)
6080# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6081!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
6082# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6083#endif
6084# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6085 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
6086#ifdef MFC_DEBUG
6087# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6088 block
6089# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6090 use iso_fortran_env, only: output_unit
6091# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6092
6093# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6094 print *, 'm_weno.fpp:1628: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
6095# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6096
6097# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6098 call flush (output_unit)
6099# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6100 end block
6101# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6102#endif
6103# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6104
6105# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6106#if defined(MFC_OpenACC)
6107# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6108!$acc exit data delete(d_cbL_z, d_cbR_z)
6109# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6110#elif defined(MFC_OpenMP)
6111# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6112!$omp target exit data map(release:d_cbL_z, d_cbR_z)
6113# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6114#endif
6115# 1628 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6116 deallocate (d_cbl_z, d_cbr_z)
6117#ifdef MFC_DEBUG
6118# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6119 block
6120# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6121 use iso_fortran_env, only: output_unit
6122# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6123
6124# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6125 print *, 'm_weno.fpp:1629: ', '@:DEALLOCATE(beta_coef_z)'
6126# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6127
6128# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6129 call flush (output_unit)
6130# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6131 end block
6132# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6133#endif
6134# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6135
6136# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6137#if defined(MFC_OpenACC)
6138# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6139!$acc exit data delete(beta_coef_z)
6140# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6141#elif defined(MFC_OpenMP)
6142# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6143!$omp target exit data map(release:beta_coef_z)
6144# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6145#endif
6146# 1629 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6147 deallocate (beta_coef_z)
6148
6149 end subroutine s_finalize_weno_module
6150
6151end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:990
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:990
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:990
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:767
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:5461
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:472
m_weno::d_cbl_z
real(wp), dimension(:,:), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:405
m_weno::poly_coef_cbl_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:369
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Definition m_weno.fpp.f90:493
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:472
m_weno::d_cbl_y
real(wp), dimension(:,:), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:404
m_weno::beta_coef_y
real(wp), dimension(:,:,:), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:427
m_weno::s_pack_weno_input_arr
subroutine, public s_pack_weno_input_arr(v_vf)
Definition m_weno.fpp.f90:3191
m_weno::d_cbr_y
real(wp), dimension(:,:), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:407
m_weno::beta_coef_x
real(wp), dimension(:,:,:), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:426
m_weno::beta_coef_z
real(wp), dimension(:,:,:), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:428
m_weno::d_cbr_x
real(wp), dimension(:,:), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:406
m_weno::d_cbr_z
real(wp), dimension(:,:), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:408
m_weno::uniform_grid
logical, dimension(3) uniform_grid
True if grid spacing is uniform in each direction.
Definition m_weno.fpp.f90:457
m_weno::poly_coef_cbl_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:371
m_weno::poly_coef_cbr_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:372
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:444
m_weno::d_cbl_x
real(wp), dimension(:,:), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:403
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:472
m_weno::poly_coef_cbr_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:373
m_weno::v_rs_weno
real(wp), dimension(:,:,:,:), allocatable v_rs_weno
Definition m_weno.fpp.f90:348
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:3241
m_weno::poly_coef_cbl_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:370
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:1088
m_weno::poly_coef_cbr_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:374
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5823
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:417