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# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44
45# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46
47# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48! New line at end of file is required for FYPP
49# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
50# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
51# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
52# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81! New line at end of file is required for FYPP
82# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
83
84# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 320 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160! New line at end of file is required for FYPP
161# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
162# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
163# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
164# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 15 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181
182# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
183
184# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
185
186# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187
188# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
189
190# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
191
192# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
193! New line at end of file is required for FYPP
194# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
195
196# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241
242# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
243
244# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251! New line at end of file is required for FYPP
252# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
253
254! GPU parallel region (scalar reductions, maxval/minval)
255# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! GPU parallel loop over threads (most common GPU macro)
258# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Required closing for GPU_PARALLEL_LOOP
261# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Mark routine for device compilation
264# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Declare device-resident data
267# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! Inner loop within a GPU parallel region
270# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! Scoped GPU data region
273# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! Host code with device pointers (for MPI with GPU buffers)
276# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Allocate device memory (unscoped)
279# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Free device memory
282# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Atomic operation on device
285# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! End atomic capture block
288# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Copy data between host and device
291# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293! Synchronization barrier
294# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295
296! Import GPU library module (openacc or omp_lib)
297# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298
299! Emit code only for AMD compiler
300# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301
302! Emit code for non-Cray compilers
303# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
304
305! Emit code only for Cray compiler
306# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308! Emit code for non-NVIDIA compilers
309# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
310
311# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313! New line at end of file is required for FYPP
314# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
315
316# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
319! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
320! example see misc/nvidia_uvm/bind.sh.
321# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323! Allocate and create GPU device memory
324# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325
326! Free GPU device memory and deallocate
327# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Cray-specific GPU pointer setup for vector fields
330# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
331
332! Cray-specific GPU pointer setup for scalar fields
333# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
334
335! Cray-specific GPU pointer setup for acoustic source spatials
336# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
337
338# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
341! New line at end of file is required for FYPP
342# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
343
344!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
345module m_weno
346
347 use m_derived_types
348 use m_global_parameters
349 use m_variables_conversion
350 use m_mpi_proxy
351 use m_thinc, only: s_thinc_compression
352 use m_nvtx
353
354 private; public :: s_initialize_weno_module, s_finalize_weno_module, s_weno, s_pack_weno_input_arr
355
356 !> @name The cell-average variables that will be WENO-reconstructed unpacked into an array for performance
357 !> @{
358 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_weno
359 !> @}
360
361# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
362#if defined(MFC_OpenACC)
363# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
364!$acc declare create(v_rs_weno)
365# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
366#elif defined(MFC_OpenMP)
367# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
368!$omp declare target (v_rs_weno)
369# 23 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
370#endif
371
372 ! WENO Coefficients
373
374 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at the left and right quadrature points (QP), in
375 !! the x-, y- and z-directions. Note that the first dimension of the array identifies the polynomial, the second dimension
376 !! identifies the position of its coefficients and the last dimension denotes the cell-location in the relevant coordinate
377 !! direction.
378 !> @{
379 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_x
380 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_y
381 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_z
382 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_x
383 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_y
384 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_z
385 !> @}
386
387# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
388#if defined(MFC_OpenACC)
389# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
390!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
391# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
392#elif defined(MFC_OpenMP)
393# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
394!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
395# 39 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
396#endif
397
398# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
399#if defined(MFC_OpenACC)
400# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
401!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
402# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
403#elif defined(MFC_OpenMP)
404# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
405!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
406# 40 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
407#endif
408
409 !> @name The ideal weights at the left and the right cell-boundaries and at the left and the right quadrature points, in x-, y-
410 !! and z-directions. Note that the first dimension of the array identifies the weight, while the last denotes the cell-location
411 !! in the relevant coordinate direction.
412 !> @{
413 real(wp), target, allocatable, dimension(:,:) :: d_cbl_x
414 real(wp), target, allocatable, dimension(:,:) :: d_cbl_y
415 real(wp), target, allocatable, dimension(:,:) :: d_cbl_z
416 real(wp), target, allocatable, dimension(:,:) :: d_cbr_x
417 real(wp), target, allocatable, dimension(:,:) :: d_cbr_y
418 real(wp), target, allocatable, dimension(:,:) :: d_cbr_z
419 !> @}
420
421# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
422#if defined(MFC_OpenACC)
423# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
424!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
425# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
426#elif defined(MFC_OpenMP)
427# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
428!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
429# 53 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
430#endif
431
432 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note that the first array dimension identifies the
433 !! smoothness indicator, the second identifies the position of its coefficients and the last denotes the cell-location in the
434 !! relevant coordinate direction.
435 !> @{
436 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_x
437 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_y
438 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_z
439 !> @}
440
441# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
442#if defined(MFC_OpenACC)
443# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
444!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
445# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
446#elif defined(MFC_OpenMP)
447# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
448!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
449# 63 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
450#endif
451
452 ! END: WENO Coefficients
453
454 integer :: v_size !< Number of WENO-reconstructed cell-average variables
455
456# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
457#if defined(MFC_OpenACC)
458# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
459!$acc declare create(v_size)
460# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
461#elif defined(MFC_OpenMP)
462# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
463!$omp declare target (v_size)
464# 68 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
465#endif
466
467 logical :: uniform_grid(3) !< True if grid spacing is uniform in each direction
468
469# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
470#if defined(MFC_OpenACC)
471# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
472!$acc declare create(uniform_grid)
473# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
474#elif defined(MFC_OpenMP)
475# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
476!$omp declare target (uniform_grid)
477# 71 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
478#endif
479
480 !> @name Indical bounds in the s1-, s2- and s3-directions
481 !> @{
482 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
483#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
484
485# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
486#if defined(MFC_OpenACC)
487# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
488!$acc declare create(is1_weno, is2_weno, is3_weno)
489# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
490#elif defined(MFC_OpenMP)
491# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
492!$omp declare target (is1_weno, is2_weno, is3_weno)
493# 77 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
494#endif
495#endif
496 !
497 !> @}
498
499contains
500
501 !> Initialize the WENO module
502 impure subroutine s_initialize_weno_module
503
504 if (weno_order == 1) return
505
506 ! Allocating/Computing WENO Coefficients in x-direction
507 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
508 if (n == 0) then
509 is2_weno%beg = 0
510 else
511 is2_weno%beg = -buff_size
512 end if
513
514 is2_weno%end = n - is2_weno%beg
515
516 if (p == 0) then
517 is3_weno%beg = 0
518 else
519 is3_weno%beg = -buff_size
520 end if
521
522 is3_weno%end = p - is3_weno%beg
523
524#ifdef MFC_DEBUG
525# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
526 block
527# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
528 use iso_fortran_env, only: output_unit
529# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
530
531# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
532 print *, 'm_weno.fpp:107: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
533# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
534
535# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
536 call flush (output_unit)
537# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
538 end block
539# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
540#endif
541# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
542 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
543# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
544
545# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
546
547# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
548#if defined(MFC_OpenACC)
549# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
550!$acc enter data create(poly_coef_cbL_x)
551# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
552#elif defined(MFC_OpenMP)
553# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
554!$omp target enter data map(always,alloc:poly_coef_cbL_x)
555# 107 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
556#endif
557#ifdef MFC_DEBUG
558# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
559 block
560# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
561 use iso_fortran_env, only: output_unit
562# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
563
564# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
565 print *, 'm_weno.fpp:108: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
566# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
567
568# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
569 call flush (output_unit)
570# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
571 end block
572# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
573#endif
574# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
575 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
576# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
577
578# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
579
580# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
581#if defined(MFC_OpenACC)
582# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
583!$acc enter data create(poly_coef_cbR_x)
584# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
585#elif defined(MFC_OpenMP)
586# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
587!$omp target enter data map(always,alloc:poly_coef_cbR_x)
588# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
589#endif
590
591#ifdef MFC_DEBUG
592# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593 block
594# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595 use iso_fortran_env, only: output_unit
596# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597
598# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599 print *, 'm_weno.fpp:110: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
600# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601
602# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603 call flush (output_unit)
604# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605 end block
606# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607#endif
608# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
609 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
610# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
611
612# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
613
614# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
615#if defined(MFC_OpenACC)
616# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
617!$acc enter data create(d_cbL_x)
618# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
619#elif defined(MFC_OpenMP)
620# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
621!$omp target enter data map(always,alloc:d_cbL_x)
622# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
623#endif
624#ifdef MFC_DEBUG
625# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
626 block
627# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
628 use iso_fortran_env, only: output_unit
629# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
630
631# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
632 print *, 'm_weno.fpp:111: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
633# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
634
635# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
636 call flush (output_unit)
637# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
638 end block
639# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
640#endif
641# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
642 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
643# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
644
645# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
646
647# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
648#if defined(MFC_OpenACC)
649# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
650!$acc enter data create(d_cbR_x)
651# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
652#elif defined(MFC_OpenMP)
653# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
654!$omp target enter data map(always,alloc:d_cbR_x)
655# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
656#endif
657
658#ifdef MFC_DEBUG
659# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
660 block
661# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
662 use iso_fortran_env, only: output_unit
663# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664
665# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666 print *, 'm_weno.fpp:113: ', '@:ALLOCATE(beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
667# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668
669# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670 call flush (output_unit)
671# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672 end block
673# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674#endif
675# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676 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))
677# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678
679# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680
681# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
682#if defined(MFC_OpenACC)
683# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
684!$acc enter data create(beta_coef_x)
685# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
686#elif defined(MFC_OpenMP)
687# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
688!$omp target enter data map(always,alloc:beta_coef_x)
689# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
690#endif
691# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
692 ! 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
693 ! differences (dvd) not the values themselves
694
695 call s_compute_weno_coefficients(1, is1_weno)
696
697#ifdef MFC_DEBUG
698# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
699 block
700# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
701 use iso_fortran_env, only: output_unit
702# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
703
704# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
705 print *, 'm_weno.fpp:120: ', '@:ALLOCATE(v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
706# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
707
708# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
709 call flush (output_unit)
710# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
711 end block
712# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713#endif
714# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
715 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))
716# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
717
718# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
719
720# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
721#if defined(MFC_OpenACC)
722# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
723!$acc enter data create(v_rs_weno)
724# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
725#elif defined(MFC_OpenMP)
726# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
727!$omp target enter data map(always,alloc:v_rs_weno)
728# 120 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
729#endif
730
731 ! Allocating/Computing WENO Coefficients in y-direction
732 if (n == 0) return
733
734 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
735 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
736
737 if (p == 0) then
738 is3_weno%beg = 0
739 else
740 is3_weno%beg = -buff_size
741 end if
742
743 is3_weno%end = p - is3_weno%beg
744
745#ifdef MFC_DEBUG
746# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 block
748# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749 use iso_fortran_env, only: output_unit
750# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751
752# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753 print *, 'm_weno.fpp:136: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
754# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755
756# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757 call flush (output_unit)
758# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759 end block
760# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761#endif
762# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
764# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
765
766# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
767
768# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
769#if defined(MFC_OpenACC)
770# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
771!$acc enter data create(poly_coef_cbL_y)
772# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
773#elif defined(MFC_OpenMP)
774# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
775!$omp target enter data map(always,alloc:poly_coef_cbL_y)
776# 136 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
777#endif
778#ifdef MFC_DEBUG
779# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
780 block
781# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782 use iso_fortran_env, only: output_unit
783# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784
785# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786 print *, 'm_weno.fpp:137: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
787# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788
789# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790 call flush (output_unit)
791# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792 end block
793# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794#endif
795# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
796 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
797# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798
799# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
800
801# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
802#if defined(MFC_OpenACC)
803# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804!$acc enter data create(poly_coef_cbR_y)
805# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806#elif defined(MFC_OpenMP)
807# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808!$omp target enter data map(always,alloc:poly_coef_cbR_y)
809# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810#endif
811
812#ifdef MFC_DEBUG
813# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
814 block
815# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
816 use iso_fortran_env, only: output_unit
817# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
818
819# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
820 print *, 'm_weno.fpp:139: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
821# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
822
823# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
824 call flush (output_unit)
825# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
826 end block
827# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
828#endif
829# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
830 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
831# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
832
833# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
834
835# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
836#if defined(MFC_OpenACC)
837# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
838!$acc enter data create(d_cbL_y)
839# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
840#elif defined(MFC_OpenMP)
841# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
842!$omp target enter data map(always,alloc:d_cbL_y)
843# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
844#endif
845#ifdef MFC_DEBUG
846# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
847 block
848# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849 use iso_fortran_env, only: output_unit
850# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851
852# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853 print *, 'm_weno.fpp:140: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
854# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855
856# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857 call flush (output_unit)
858# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859 end block
860# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861#endif
862# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
863 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
864# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865
866# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
867
868# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
869#if defined(MFC_OpenACC)
870# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871!$acc enter data create(d_cbR_y)
872# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873#elif defined(MFC_OpenMP)
874# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875!$omp target enter data map(always,alloc:d_cbR_y)
876# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877#endif
878
879#ifdef MFC_DEBUG
880# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
881 block
882# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
883 use iso_fortran_env, only: output_unit
884# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
885
886# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
887 print *, 'm_weno.fpp:142: ', '@:ALLOCATE(beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
888# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
889
890# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
891 call flush (output_unit)
892# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
893 end block
894# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
895#endif
896# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
897 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))
898# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
899
900# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
901
902# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
903#if defined(MFC_OpenACC)
904# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
905!$acc enter data create(beta_coef_y)
906# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
907#elif defined(MFC_OpenMP)
908# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
909!$omp target enter data map(always,alloc:beta_coef_y)
910# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
911#endif
912# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
913
914 call s_compute_weno_coefficients(2, is2_weno)
915
916 ! Allocating/Computing WENO Coefficients in z-direction
917 if (p == 0) return
918
919 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
920 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
921 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
922
923#ifdef MFC_DEBUG
924# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
925 block
926# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
927 use iso_fortran_env, only: output_unit
928# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
929
930# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
931 print *, 'm_weno.fpp:154: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
932# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
933
934# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
935 call flush (output_unit)
936# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
937 end block
938# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
939#endif
940# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
941 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
942# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
943
944# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
945
946# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
947#if defined(MFC_OpenACC)
948# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
949!$acc enter data create(poly_coef_cbL_z)
950# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
951#elif defined(MFC_OpenMP)
952# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
953!$omp target enter data map(always,alloc:poly_coef_cbL_z)
954# 154 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
955#endif
956#ifdef MFC_DEBUG
957# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958 block
959# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960 use iso_fortran_env, only: output_unit
961# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962
963# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964 print *, 'm_weno.fpp:155: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
965# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966
967# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968 call flush (output_unit)
969# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970 end block
971# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972#endif
973# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
974 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
975# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976
977# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
978
979# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
980#if defined(MFC_OpenACC)
981# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
982!$acc enter data create(poly_coef_cbR_z)
983# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984#elif defined(MFC_OpenMP)
985# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986!$omp target enter data map(always,alloc:poly_coef_cbR_z)
987# 155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988#endif
989
990#ifdef MFC_DEBUG
991# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992 block
993# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
994 use iso_fortran_env, only: output_unit
995# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
996
997# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
998 print *, 'm_weno.fpp:157: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
999# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1000
1001# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1002 call flush (output_unit)
1003# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1004 end block
1005# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1006#endif
1007# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1008 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1009# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1010
1011# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1012
1013# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1014#if defined(MFC_OpenACC)
1015# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1016!$acc enter data create(d_cbL_z)
1017# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1018#elif defined(MFC_OpenMP)
1019# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1020!$omp target enter data map(always,alloc:d_cbL_z)
1021# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1022#endif
1023#ifdef MFC_DEBUG
1024# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025 block
1026# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027 use iso_fortran_env, only: output_unit
1028# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1029
1030# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1031 print *, 'm_weno.fpp:158: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1032# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1033
1034# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1035 call flush (output_unit)
1036# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1037 end block
1038# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1039#endif
1040# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1041 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1042# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1043
1044# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1045
1046# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1047#if defined(MFC_OpenACC)
1048# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1049!$acc enter data create(d_cbR_z)
1050# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1051#elif defined(MFC_OpenMP)
1052# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1053!$omp target enter data map(always,alloc:d_cbR_z)
1054# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1055#endif
1056
1057#ifdef MFC_DEBUG
1058# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1059 block
1060# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1061 use iso_fortran_env, only: output_unit
1062# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1063
1064# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1065 print *, 'm_weno.fpp:160: ', '@:ALLOCATE(beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
1066# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1067
1068# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1069 call flush (output_unit)
1070# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1071 end block
1072# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1073#endif
1074# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1075 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))
1076# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1077
1078# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1079
1080# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1081#if defined(MFC_OpenACC)
1082# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1083!$acc enter data create(beta_coef_z)
1084# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1085#elif defined(MFC_OpenMP)
1086# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1087!$omp target enter data map(always,alloc:beta_coef_z)
1088# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1089#endif
1090# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1091
1092 call s_compute_weno_coefficients(3, is3_weno)
1093
1094 end subroutine s_initialize_weno_module
1095
1096 !> Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction
1097 subroutine s_compute_weno_coefficients(weno_dir, is)
1098
1099 ! Compute WENO coefficients for a given coordinate direction. Shu (1997)
1100 integer, intent(in) :: weno_dir
1101 type(int_bounds_info), intent(in) :: is
1102 integer :: s
1103 real(wp), pointer, dimension(:) :: s_cb => null() !< Cell-boundary locations in the s-direction
1104 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1105 integer :: i !< Generic loop iterator
1106 real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil
1107 real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1108 real(wp) :: h0 !< Reference spacing for uniform-grid detection
1109
1110 ! Determine cell count, boundary locations, and BCs for selected WENO direction
1111
1112 if (weno_dir == 1) then
1113 s = m; s_cb => x_cb; bc_s = bc_x
1114 else if (weno_dir == 2) then
1115 s = n; s_cb => y_cb; bc_s = bc_y
1116 else
1117 s = p; s_cb => z_cb; bc_s = bc_z
1118 end if
1119
1120# 192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1121 ! Computing WENO3 Coefficients
1122 if (weno_dir == 1) then
1123 if (weno_order == 3) then
1124 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1125 ! Polynomial reconstruction coefficients
1126 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1127 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1128
1129 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1130 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1131
1132 ! Ideal (linear) weights
1133 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1134 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1135
1136 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1137 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1138
1139 ! Smoothness indicator coefficients
1140 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
1141 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
1142 end do
1143
1144 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1145 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1146 if (null_weights) then
1147 if (bc_s%beg == bc_riemann_extrap) then
1148 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1149 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1150 end if
1151
1152 if (bc_s%end == bc_riemann_extrap) then
1153 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1154 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1155 end if
1156 end if
1157 ! END: Computing WENO3 Coefficients
1158
1159 ! Computing WENO5 Coefficients
1160 else if (weno_order == 5) then
1161 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1162 ! Polynomial reconstruction coefficients
1163 poly_coef_cbr_x(i + 1, 0, &
1164 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1165 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1166 poly_coef_cbr_x(i + 1, 1, &
1167 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1168 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1169 poly_coef_cbr_x(i + 1, 1, &
1170 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1171 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1172 poly_coef_cbr_x(i + 1, 2, &
1173 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1174 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1175 poly_coef_cbl_x(i + 1, 0, &
1176 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1177 & *(s_cb(i + 3) - s_cb(i + 1)))
1178 poly_coef_cbl_x(i + 1, 1, &
1179 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1180 & + 2))*(s_cb(i) - s_cb(i + 2)))
1181 poly_coef_cbl_x(i + 1, 1, &
1182 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1183 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1184 poly_coef_cbl_x(i + 1, 2, &
1185 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1186 & *(s_cb(i - 2) - s_cb(i + 1)))
1187
1188 poly_coef_cbr_x(i + 1, 0, &
1189 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1190 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1191 poly_coef_cbr_x(i + 1, 2, &
1192 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1193 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1194 poly_coef_cbl_x(i + 1, 0, &
1195 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1196 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1197 poly_coef_cbl_x(i + 1, 2, &
1198 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1199 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1200
1201 ! Ideal (linear) weights
1202 d_cbr_x(0, &
1203 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1204 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1205 d_cbr_x(2, &
1206 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1207 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1208 d_cbl_x(0, &
1209 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1210 & *(s_cb(i + 3) - s_cb(i - 1)))
1211 d_cbl_x(2, &
1212 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1213 & *(s_cb(i - 2) - s_cb(i + 3)))
1214
1215 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1216 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1217
1218 ! Smoothness indicator coefficients
1219 beta_coef_x(i + 1, 0, &
1220 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1221 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1222 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1223
1224 beta_coef_x(i + 1, 0, &
1225 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1226 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1227 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1228 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1229
1230 beta_coef_x(i + 1, 0, &
1231 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1232 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1233 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1234 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1235
1236 beta_coef_x(i + 1, 1, &
1237 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1238 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1239 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1240
1241 beta_coef_x(i + 1, 1, &
1242 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1243 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1244 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1245 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1246
1247 beta_coef_x(i + 1, 1, &
1248 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1249 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1250 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1251
1252 beta_coef_x(i + 1, 2, &
1253 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1254 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1255 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1256 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1257
1258 beta_coef_x(i + 1, 2, &
1259 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1260 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1261 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1262 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1263
1264 beta_coef_x(i + 1, 2, &
1265 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1266 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1267 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1268 end do
1269
1270 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1271 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1272 if (null_weights) then
1273 if (bc_s%beg == bc_riemann_extrap) then
1274 d_cbr_x(1:2,0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1275 d_cbl_x(1:2,0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1276 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:,1) = d_cbr_x(:,1)/sum(d_cbr_x(:,1))
1277 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:,1) = d_cbl_x(:,1)/sum(d_cbl_x(:,1))
1278 end if
1279
1280 if (bc_s%end == bc_riemann_extrap) then
1281 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:,s - 1) = d_cbr_x(:, &
1282 & s - 1)/sum(d_cbr_x(:,s - 1))
1283 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:,s - 1) = d_cbl_x(:, &
1284 & s - 1)/sum(d_cbl_x(:,s - 1))
1285 d_cbr_x(0:1,s) = 0._wp; d_cbr_x(2, s) = 1._wp
1286 d_cbl_x(0:1,s) = 0._wp; d_cbl_x(2, s) = 1._wp
1287 end if
1288 end if
1289 else
1290 if (.not. teno) then
1291 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1292 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1293 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1294 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1295 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1296 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1297 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1298 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1299 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1300 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1301 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1302 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1303
1304 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1305 d_cbr_x(0, &
1306 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1307 & *(w(1) - w(8)))
1308 d_cbr_x(1, &
1309 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1310 & *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) &
1311 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1312 & *(w(2) - w(8)))
1313 d_cbr_x(2, &
1314 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1315 & *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) &
1316 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1317 & *(w(3) - w(8)))
1318 d_cbr_x(3, &
1319 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1320 & *(w(3) - w(8)))
1321
1322 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
1323 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
1324 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
1325 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
1326 w(1) = s_cb(i + 4) - s_cb(i)
1327 w(2) = s_cb(i + 3) - s_cb(i)
1328 w(3) = s_cb(i + 2) - s_cb(i)
1329 w(4) = s_cb(i + 1) - s_cb(i)
1330 w(5) = s_cb(i) - s_cb(i)
1331 w(6) = s_cb(i - 1) - s_cb(i)
1332 w(7) = s_cb(i - 2) - s_cb(i)
1333 w(8) = s_cb(i - 3) - s_cb(i)
1334 d_cbl_x(0, &
1335 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1336 & *(w(3) - w(8)))
1337 d_cbl_x(1, &
1338 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1339 & *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) &
1340 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1341 & *(w(3) - w(8)))
1342 d_cbl_x(2, &
1343 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1344 & *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) &
1345 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1346 & *(w(2) - w(8)))
1347 d_cbl_x(3, &
1348 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1349 & *(w(1) - w(8)))
1350 ! Note: Left has the reversed order of both points and coefficients compared to the right
1351
1352 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1353 poly_coef_cbr_x(i + 1, 0, &
1354 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1355 & + y(2) + y(3) + y(4)))
1356 poly_coef_cbr_x(i + 1, 0, &
1357 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1358 & + 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) &
1359 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1360 poly_coef_cbr_x(i + 1, 0, &
1361 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1362 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1363 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1364
1365 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1366 poly_coef_cbr_x(i + 1, 1, &
1367 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1368 & + y(2) + y(3) + y(4)))
1369 poly_coef_cbr_x(i + 1, 1, &
1370 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1371 & + 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) &
1372 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1373 poly_coef_cbr_x(i + 1, 1, &
1374 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1375 & + y(2) + y(3) + y(4)))
1376
1377 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1378 poly_coef_cbr_x(i + 1, 2, &
1379 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1380 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1381 poly_coef_cbr_x(i + 1, 2, &
1382 & 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 &
1383 & + 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) &
1384 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1385 poly_coef_cbr_x(i + 1, 2, &
1386 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1387 & + y(2) + y(3) + y(4)))
1388
1389 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1390 poly_coef_cbr_x(i + 1, 3, &
1391 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1392 & + 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) &
1393 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1394 poly_coef_cbr_x(i + 1, 3, &
1395 & 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) &
1396 & + 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)) &
1397 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1398 & + y(4)))
1399 poly_coef_cbr_x(i + 1, 3, &
1400 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1401 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1402
1403 ! Element-wise: see the no-reversed-sections note above.
1404 y(1) = s_cb(i + 1) - s_cb(i)
1405 y(2) = s_cb(i) - s_cb(i - 1)
1406 y(3) = s_cb(i - 1) - s_cb(i - 2)
1407 y(4) = s_cb(i - 2) - s_cb(i - 3)
1408 poly_coef_cbl_x(i + 1, 3, &
1409 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1410 & + y(2) + y(3) + y(4)))
1411 poly_coef_cbl_x(i + 1, 3, &
1412 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1413 & + 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) &
1414 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1415 poly_coef_cbl_x(i + 1, 3, &
1416 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1417 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1418 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1419
1420 ! Element-wise: see the no-reversed-sections note above.
1421 y(1) = s_cb(i + 2) - s_cb(i + 1)
1422 y(2) = s_cb(i + 1) - s_cb(i)
1423 y(3) = s_cb(i) - s_cb(i - 1)
1424 y(4) = s_cb(i - 1) - s_cb(i - 2)
1425 poly_coef_cbl_x(i + 1, 2, &
1426 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1427 & + y(2) + y(3) + y(4)))
1428 poly_coef_cbl_x(i + 1, 2, &
1429 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1430 & + 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) &
1431 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1432 poly_coef_cbl_x(i + 1, 2, &
1433 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1434 & + y(2) + y(3) + y(4)))
1435
1436 ! Element-wise: see the no-reversed-sections note above.
1437 y(1) = s_cb(i + 3) - s_cb(i + 2)
1438 y(2) = s_cb(i + 2) - s_cb(i + 1)
1439 y(3) = s_cb(i + 1) - s_cb(i)
1440 y(4) = s_cb(i) - s_cb(i - 1)
1441 poly_coef_cbl_x(i + 1, 1, &
1442 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1443 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1444 poly_coef_cbl_x(i + 1, 1, &
1445 & 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 &
1446 & + 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) &
1447 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1448 poly_coef_cbl_x(i + 1, 1, &
1449 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1450 & + y(2) + y(3) + y(4)))
1451
1452 ! Element-wise: see the no-reversed-sections note above.
1453 y(1) = s_cb(i + 4) - s_cb(i + 3)
1454 y(2) = s_cb(i + 3) - s_cb(i + 2)
1455 y(3) = s_cb(i + 2) - s_cb(i + 1)
1456 y(4) = s_cb(i + 1) - s_cb(i)
1457 poly_coef_cbl_x(i + 1, 0, &
1458 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1459 & + 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) &
1460 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1461 poly_coef_cbl_x(i + 1, 0, &
1462 & 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) &
1463 & + 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)) &
1464 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1465 & + y(4)))
1466 poly_coef_cbl_x(i + 1, 0, &
1467 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1468 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1469
1470 poly_coef_cbl_x(i + 1,:,:) = -poly_coef_cbl_x(i + 1,:,:)
1471 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1472
1473 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1474 beta_coef_x(i + 1, 3, &
1475 & 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) &
1476 & + 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) &
1477 & **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 &
1478 & + 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) &
1479 & *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) &
1480 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
1481 & + 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) &
1482 & *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) &
1483 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
1484 & **2*(y(1) + y(2) + y(3) + y(4))**2)
1485 beta_coef_x(i + 1, 3, &
1486 & 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) &
1487 & **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) &
1488 & + 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) &
1489 & + 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) &
1490 & + 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) &
1491 & *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) &
1492 & *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) &
1493 & *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) &
1494 & **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) &
1495 & **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) &
1496 & *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) &
1497 & + 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) &
1498 & *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) &
1499 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
1500 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
1501 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1502 beta_coef_x(i + 1, 3, &
1503 & 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) &
1504 & **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) &
1505 & + 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) &
1506 & *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 &
1507 & + 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) &
1508 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
1509 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1510 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1511 beta_coef_x(i + 1, 3, &
1512 & 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 &
1513 & + 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 &
1514 & + 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 &
1515 & + 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) &
1516 & + 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) &
1517 & **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) &
1518 & **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) &
1519 & **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) &
1520 & **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) &
1521 & *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) &
1522 & **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) &
1523 & **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) &
1524 & **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) &
1525 & **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) &
1526 & **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) &
1527 & **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) &
1528 & **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) &
1529 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
1530 & + 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 &
1531 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
1532 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
1533 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1534 & + y(3) + y(4))**2)
1535 beta_coef_x(i + 1, 3, &
1536 & 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) &
1537 & **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) &
1538 & **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) &
1539 & **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) &
1540 & *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) &
1541 & *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) &
1542 & **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) &
1543 & **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) &
1544 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
1545 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
1546 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
1547 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1548 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1549 beta_coef_x(i + 1, 3, &
1550 & 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 &
1551 & + 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) &
1552 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
1553 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
1554 & + y(4))**2)
1555
1556 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1557 beta_coef_x(i + 1, 2, &
1558 & 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 &
1559 & + 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) &
1560 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
1561 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
1562 & + y(4))**2)
1563 beta_coef_x(i + 1, 2, &
1564 & 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 &
1565 & + 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) &
1566 & - 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 &
1567 & - 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 &
1568 & + 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 &
1569 & + 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 &
1570 & + 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 &
1571 & + 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) &
1572 & **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 &
1573 & - 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 &
1574 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
1575 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
1576 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
1577 & **2)
1578 beta_coef_x(i + 1, 2, &
1579 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
1580 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
1581 & + 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) &
1582 & *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)) &
1583 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1584 & + y(4))**2)
1585 beta_coef_x(i + 1, 2, &
1586 & 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 &
1587 & + 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 &
1588 & + 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 &
1589 & + 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) &
1590 & + 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) &
1591 & **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) &
1592 & **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) &
1593 & **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) &
1594 & **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) &
1595 & *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 &
1596 & + 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) &
1597 & **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 &
1598 & + 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 &
1599 & + 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) &
1600 & **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) &
1601 & *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) &
1602 & + 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 &
1603 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
1604 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
1605 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
1606 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1607 & + y(3) + y(4))**2)
1608 beta_coef_x(i + 1, 2, &
1609 & 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) &
1610 & **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) &
1611 & *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) &
1612 & *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) &
1613 & *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) &
1614 & **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) &
1615 & **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) &
1616 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
1617 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
1618 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
1619 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
1620 & **2)
1621 beta_coef_x(i + 1, 2, &
1622 & 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 &
1623 & - 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)) &
1624 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
1625
1626 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1627 beta_coef_x(i + 1, 1, &
1628 & 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 &
1629 & - 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)) &
1630 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1631 beta_coef_x(i + 1, 1, &
1632 & 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) &
1633 & *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) &
1634 & **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) &
1635 & **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) &
1636 & **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) &
1637 & **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) &
1638 & **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) &
1639 & *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) &
1640 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
1641 & **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) &
1642 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1643 & + y(3) + y(4))**2)
1644 beta_coef_x(i + 1, 1, &
1645 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
1646 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
1647 & + 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) &
1648 & *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)) &
1649 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1650 & + y(4))**2)
1651 beta_coef_x(i + 1, 1, &
1652 & 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) &
1653 & + 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) &
1654 & **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) &
1655 & **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) &
1656 & **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) &
1657 & **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) &
1658 & + 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) &
1659 & **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) &
1660 & **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) &
1661 & **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) &
1662 & **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) &
1663 & - 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) &
1664 & **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) &
1665 & **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) &
1666 & *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) &
1667 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
1668 & **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) &
1669 & **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) &
1670 & **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) &
1671 & **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) &
1672 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1673 beta_coef_x(i + 1, 1, &
1674 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
1675 & **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) &
1676 & **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) &
1677 & *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) &
1678 & + 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) &
1679 & **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) &
1680 & **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) &
1681 & **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) &
1682 & **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 &
1683 & - 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 &
1684 & - 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) &
1685 & **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) &
1686 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1687 beta_coef_x(i + 1, 1, &
1688 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
1689 & **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 &
1690 & + 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) &
1691 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1692 & + y(3) + y(4))**2)
1693
1694 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1695 beta_coef_x(i + 1, 0, &
1696 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
1697 & **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 &
1698 & + 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) &
1699 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1700 & + y(3) + y(4))**2)
1701 beta_coef_x(i + 1, 0, &
1702 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
1703 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
1704 & **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) &
1705 & **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) &
1706 & + 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) &
1707 & **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 &
1708 & + 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) &
1709 & **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) &
1710 & *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 &
1711 & + 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) &
1712 & + 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) &
1713 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1714 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1715 beta_coef_x(i + 1, 0, &
1716 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
1717 & *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) &
1718 & + 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) &
1719 & **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) &
1720 & + 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) &
1721 & *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) &
1722 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
1723 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1724 beta_coef_x(i + 1, 0, &
1725 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
1726 & **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) &
1727 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
1728 & + 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) &
1729 & + 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) &
1730 & *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) &
1731 & *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) &
1732 & + 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) &
1733 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
1734 & + 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) &
1735 & **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) &
1736 & **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) &
1737 & *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) &
1738 & **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) &
1739 & **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 &
1740 & + 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) &
1741 & + 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 &
1742 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
1743 & + 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) &
1744 & **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) &
1745 & **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) &
1746 & **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)) &
1747 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1748 beta_coef_x(i + 1, 0, &
1749 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
1750 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
1751 & **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) &
1752 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
1753 & **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) &
1754 & **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) &
1755 & **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) &
1756 & + 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) &
1757 & + 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) &
1758 & + 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) &
1759 & *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 &
1760 & + 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) &
1761 & *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) &
1762 & + 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) &
1763 & **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)) &
1764 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1765 & + y(4))**2)
1766 beta_coef_x(i + 1, 0, &
1767 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
1768 & **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) &
1769 & + 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) &
1770 & *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 &
1771 & + 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) &
1772 & **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) &
1773 & + 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) &
1774 & **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) &
1775 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1776 & + y(3) + y(4))**2)
1777 end do
1778 else
1779 ! (Fu, et al., 2016) Table 2 (for right flux)
1780 d_cbl_x(0,:) = 18._wp/35._wp
1781 d_cbl_x(1,:) = 3._wp/35._wp
1782 d_cbl_x(2,:) = 9._wp/35._wp
1783 d_cbl_x(3,:) = 1._wp/35._wp
1784 d_cbl_x(4,:) = 4._wp/35._wp
1785
1786 d_cbr_x(0,:) = 18._wp/35._wp
1787 d_cbr_x(1,:) = 9._wp/35._wp
1788 d_cbr_x(2,:) = 3._wp/35._wp
1789 d_cbr_x(3,:) = 4._wp/35._wp
1790 d_cbr_x(4,:) = 1._wp/35._wp
1791 end if
1792 end if
1793 end if
1794# 192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1795 ! Computing WENO3 Coefficients
1796 if (weno_dir == 2) then
1797 if (weno_order == 3) then
1798 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1799 ! Polynomial reconstruction coefficients
1800 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1801 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1802
1803 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1804 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1805
1806 ! Ideal (linear) weights
1807 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1808 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1809
1810 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1811 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1812
1813 ! Smoothness indicator coefficients
1814 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
1815 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
1816 end do
1817
1818 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1819 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1820 if (null_weights) then
1821 if (bc_s%beg == bc_riemann_extrap) then
1822 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1823 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1824 end if
1825
1826 if (bc_s%end == bc_riemann_extrap) then
1827 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1828 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1829 end if
1830 end if
1831 ! END: Computing WENO3 Coefficients
1832
1833 ! Computing WENO5 Coefficients
1834 else if (weno_order == 5) then
1835 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1836 ! Polynomial reconstruction coefficients
1837 poly_coef_cbr_y(i + 1, 0, &
1838 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1839 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1840 poly_coef_cbr_y(i + 1, 1, &
1841 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1842 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1843 poly_coef_cbr_y(i + 1, 1, &
1844 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1845 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1846 poly_coef_cbr_y(i + 1, 2, &
1847 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1848 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1849 poly_coef_cbl_y(i + 1, 0, &
1850 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1851 & *(s_cb(i + 3) - s_cb(i + 1)))
1852 poly_coef_cbl_y(i + 1, 1, &
1853 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1854 & + 2))*(s_cb(i) - s_cb(i + 2)))
1855 poly_coef_cbl_y(i + 1, 1, &
1856 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1857 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1858 poly_coef_cbl_y(i + 1, 2, &
1859 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1860 & *(s_cb(i - 2) - s_cb(i + 1)))
1861
1862 poly_coef_cbr_y(i + 1, 0, &
1863 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1864 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1865 poly_coef_cbr_y(i + 1, 2, &
1866 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1867 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1868 poly_coef_cbl_y(i + 1, 0, &
1869 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1870 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1871 poly_coef_cbl_y(i + 1, 2, &
1872 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1873 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1874
1875 ! Ideal (linear) weights
1876 d_cbr_y(0, &
1877 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1878 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1879 d_cbr_y(2, &
1880 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1881 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1882 d_cbl_y(0, &
1883 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1884 & *(s_cb(i + 3) - s_cb(i - 1)))
1885 d_cbl_y(2, &
1886 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1887 & *(s_cb(i - 2) - s_cb(i + 3)))
1888
1889 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1890 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1891
1892 ! Smoothness indicator coefficients
1893 beta_coef_y(i + 1, 0, &
1894 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1895 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1896 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1897
1898 beta_coef_y(i + 1, 0, &
1899 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1900 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1901 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1902 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1903
1904 beta_coef_y(i + 1, 0, &
1905 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1906 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1907 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1908 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1909
1910 beta_coef_y(i + 1, 1, &
1911 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1912 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1913 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1914
1915 beta_coef_y(i + 1, 1, &
1916 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1917 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1918 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1919 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1920
1921 beta_coef_y(i + 1, 1, &
1922 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1923 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1924 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1925
1926 beta_coef_y(i + 1, 2, &
1927 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1928 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1929 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1930 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1931
1932 beta_coef_y(i + 1, 2, &
1933 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1934 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1935 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1936 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1937
1938 beta_coef_y(i + 1, 2, &
1939 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1940 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1941 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1942 end do
1943
1944 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1945 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1946 if (null_weights) then
1947 if (bc_s%beg == bc_riemann_extrap) then
1948 d_cbr_y(1:2,0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1949 d_cbl_y(1:2,0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1950 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:,1) = d_cbr_y(:,1)/sum(d_cbr_y(:,1))
1951 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:,1) = d_cbl_y(:,1)/sum(d_cbl_y(:,1))
1952 end if
1953
1954 if (bc_s%end == bc_riemann_extrap) then
1955 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:,s - 1) = d_cbr_y(:, &
1956 & s - 1)/sum(d_cbr_y(:,s - 1))
1957 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:,s - 1) = d_cbl_y(:, &
1958 & s - 1)/sum(d_cbl_y(:,s - 1))
1959 d_cbr_y(0:1,s) = 0._wp; d_cbr_y(2, s) = 1._wp
1960 d_cbl_y(0:1,s) = 0._wp; d_cbl_y(2, s) = 1._wp
1961 end if
1962 end if
1963 else
1964 if (.not. teno) then
1965 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1966 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1967 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1968 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1969 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1970 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1971 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1972 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1973 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1974 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1975 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1976 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1977
1978 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1979 d_cbr_y(0, &
1980 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1981 & *(w(1) - w(8)))
1982 d_cbr_y(1, &
1983 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1984 & *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) &
1985 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1986 & *(w(2) - w(8)))
1987 d_cbr_y(2, &
1988 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1989 & *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) &
1990 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1991 & *(w(3) - w(8)))
1992 d_cbr_y(3, &
1993 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1994 & *(w(3) - w(8)))
1995
1996 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
1997 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
1998 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
1999 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
2000 w(1) = s_cb(i + 4) - s_cb(i)
2001 w(2) = s_cb(i + 3) - s_cb(i)
2002 w(3) = s_cb(i + 2) - s_cb(i)
2003 w(4) = s_cb(i + 1) - s_cb(i)
2004 w(5) = s_cb(i) - s_cb(i)
2005 w(6) = s_cb(i - 1) - s_cb(i)
2006 w(7) = s_cb(i - 2) - s_cb(i)
2007 w(8) = s_cb(i - 3) - s_cb(i)
2008 d_cbl_y(0, &
2009 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2010 & *(w(3) - w(8)))
2011 d_cbl_y(1, &
2012 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2013 & *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) &
2014 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2015 & *(w(3) - w(8)))
2016 d_cbl_y(2, &
2017 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2018 & *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) &
2019 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2020 & *(w(2) - w(8)))
2021 d_cbl_y(3, &
2022 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2023 & *(w(1) - w(8)))
2024 ! Note: Left has the reversed order of both points and coefficients compared to the right
2025
2026 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2027 poly_coef_cbr_y(i + 1, 0, &
2028 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2029 & + y(2) + y(3) + y(4)))
2030 poly_coef_cbr_y(i + 1, 0, &
2031 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2032 & + 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) &
2033 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2034 poly_coef_cbr_y(i + 1, 0, &
2035 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2036 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2037 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2038
2039 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2040 poly_coef_cbr_y(i + 1, 1, &
2041 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2042 & + y(2) + y(3) + y(4)))
2043 poly_coef_cbr_y(i + 1, 1, &
2044 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2045 & + 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) &
2046 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2047 poly_coef_cbr_y(i + 1, 1, &
2048 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2049 & + y(2) + y(3) + y(4)))
2050
2051 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2052 poly_coef_cbr_y(i + 1, 2, &
2053 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2054 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2055 poly_coef_cbr_y(i + 1, 2, &
2056 & 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 &
2057 & + 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) &
2058 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2059 poly_coef_cbr_y(i + 1, 2, &
2060 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2061 & + y(2) + y(3) + y(4)))
2062
2063 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2064 poly_coef_cbr_y(i + 1, 3, &
2065 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2066 & + 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) &
2067 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2068 poly_coef_cbr_y(i + 1, 3, &
2069 & 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) &
2070 & + 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)) &
2071 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2072 & + y(4)))
2073 poly_coef_cbr_y(i + 1, 3, &
2074 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2075 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2076
2077 ! Element-wise: see the no-reversed-sections note above.
2078 y(1) = s_cb(i + 1) - s_cb(i)
2079 y(2) = s_cb(i) - s_cb(i - 1)
2080 y(3) = s_cb(i - 1) - s_cb(i - 2)
2081 y(4) = s_cb(i - 2) - s_cb(i - 3)
2082 poly_coef_cbl_y(i + 1, 3, &
2083 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2084 & + y(2) + y(3) + y(4)))
2085 poly_coef_cbl_y(i + 1, 3, &
2086 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2087 & + 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) &
2088 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2089 poly_coef_cbl_y(i + 1, 3, &
2090 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2091 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2092 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2093
2094 ! Element-wise: see the no-reversed-sections note above.
2095 y(1) = s_cb(i + 2) - s_cb(i + 1)
2096 y(2) = s_cb(i + 1) - s_cb(i)
2097 y(3) = s_cb(i) - s_cb(i - 1)
2098 y(4) = s_cb(i - 1) - s_cb(i - 2)
2099 poly_coef_cbl_y(i + 1, 2, &
2100 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2101 & + y(2) + y(3) + y(4)))
2102 poly_coef_cbl_y(i + 1, 2, &
2103 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2104 & + 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) &
2105 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2106 poly_coef_cbl_y(i + 1, 2, &
2107 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2108 & + y(2) + y(3) + y(4)))
2109
2110 ! Element-wise: see the no-reversed-sections note above.
2111 y(1) = s_cb(i + 3) - s_cb(i + 2)
2112 y(2) = s_cb(i + 2) - s_cb(i + 1)
2113 y(3) = s_cb(i + 1) - s_cb(i)
2114 y(4) = s_cb(i) - s_cb(i - 1)
2115 poly_coef_cbl_y(i + 1, 1, &
2116 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2117 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2118 poly_coef_cbl_y(i + 1, 1, &
2119 & 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 &
2120 & + 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) &
2121 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2122 poly_coef_cbl_y(i + 1, 1, &
2123 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2124 & + y(2) + y(3) + y(4)))
2125
2126 ! Element-wise: see the no-reversed-sections note above.
2127 y(1) = s_cb(i + 4) - s_cb(i + 3)
2128 y(2) = s_cb(i + 3) - s_cb(i + 2)
2129 y(3) = s_cb(i + 2) - s_cb(i + 1)
2130 y(4) = s_cb(i + 1) - s_cb(i)
2131 poly_coef_cbl_y(i + 1, 0, &
2132 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2133 & + 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) &
2134 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2135 poly_coef_cbl_y(i + 1, 0, &
2136 & 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) &
2137 & + 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)) &
2138 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2139 & + y(4)))
2140 poly_coef_cbl_y(i + 1, 0, &
2141 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2142 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2143
2144 poly_coef_cbl_y(i + 1,:,:) = -poly_coef_cbl_y(i + 1,:,:)
2145 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2146
2147 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2148 beta_coef_y(i + 1, 3, &
2149 & 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) &
2150 & + 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) &
2151 & **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 &
2152 & + 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) &
2153 & *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) &
2154 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2155 & + 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) &
2156 & *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) &
2157 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2158 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2159 beta_coef_y(i + 1, 3, &
2160 & 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) &
2161 & **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) &
2162 & + 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) &
2163 & + 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) &
2164 & + 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) &
2165 & *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) &
2166 & *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) &
2167 & *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) &
2168 & **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) &
2169 & **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) &
2170 & *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) &
2171 & + 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) &
2172 & *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) &
2173 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2174 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2175 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2176 beta_coef_y(i + 1, 3, &
2177 & 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) &
2178 & **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) &
2179 & + 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) &
2180 & *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 &
2181 & + 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) &
2182 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2183 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2184 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2185 beta_coef_y(i + 1, 3, &
2186 & 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 &
2187 & + 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 &
2188 & + 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 &
2189 & + 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) &
2190 & + 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) &
2191 & **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) &
2192 & **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) &
2193 & **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) &
2194 & **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) &
2195 & *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) &
2196 & **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) &
2197 & **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) &
2198 & **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) &
2199 & **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) &
2200 & **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) &
2201 & **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) &
2202 & **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) &
2203 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2204 & + 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 &
2205 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2206 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2207 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2208 & + y(3) + y(4))**2)
2209 beta_coef_y(i + 1, 3, &
2210 & 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) &
2211 & **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) &
2212 & **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) &
2213 & **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) &
2214 & *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) &
2215 & *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) &
2216 & **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) &
2217 & **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) &
2218 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2219 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2220 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2221 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2222 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2223 beta_coef_y(i + 1, 3, &
2224 & 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 &
2225 & + 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) &
2226 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2227 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2228 & + y(4))**2)
2229
2230 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2231 beta_coef_y(i + 1, 2, &
2232 & 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 &
2233 & + 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) &
2234 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2235 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2236 & + y(4))**2)
2237 beta_coef_y(i + 1, 2, &
2238 & 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 &
2239 & + 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) &
2240 & - 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 &
2241 & - 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 &
2242 & + 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 &
2243 & + 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 &
2244 & + 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 &
2245 & + 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) &
2246 & **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 &
2247 & - 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 &
2248 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2249 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2250 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2251 & **2)
2252 beta_coef_y(i + 1, 2, &
2253 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2254 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2255 & + 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) &
2256 & *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)) &
2257 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2258 & + y(4))**2)
2259 beta_coef_y(i + 1, 2, &
2260 & 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 &
2261 & + 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 &
2262 & + 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 &
2263 & + 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) &
2264 & + 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) &
2265 & **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) &
2266 & **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) &
2267 & **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) &
2268 & **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) &
2269 & *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 &
2270 & + 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) &
2271 & **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 &
2272 & + 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 &
2273 & + 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) &
2274 & **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) &
2275 & *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) &
2276 & + 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 &
2277 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2278 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2279 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2280 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2281 & + y(3) + y(4))**2)
2282 beta_coef_y(i + 1, 2, &
2283 & 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) &
2284 & **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) &
2285 & *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) &
2286 & *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) &
2287 & *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) &
2288 & **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) &
2289 & **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) &
2290 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2291 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2292 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2293 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2294 & **2)
2295 beta_coef_y(i + 1, 2, &
2296 & 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 &
2297 & - 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)) &
2298 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2299
2300 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2301 beta_coef_y(i + 1, 1, &
2302 & 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 &
2303 & - 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)) &
2304 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2305 beta_coef_y(i + 1, 1, &
2306 & 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) &
2307 & *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) &
2308 & **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) &
2309 & **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) &
2310 & **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) &
2311 & **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) &
2312 & **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) &
2313 & *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) &
2314 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2315 & **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) &
2316 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2317 & + y(3) + y(4))**2)
2318 beta_coef_y(i + 1, 1, &
2319 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2320 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2321 & + 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) &
2322 & *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)) &
2323 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2324 & + y(4))**2)
2325 beta_coef_y(i + 1, 1, &
2326 & 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) &
2327 & + 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) &
2328 & **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) &
2329 & **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) &
2330 & **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) &
2331 & **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) &
2332 & + 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) &
2333 & **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) &
2334 & **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) &
2335 & **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) &
2336 & **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) &
2337 & - 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) &
2338 & **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) &
2339 & **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) &
2340 & *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) &
2341 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2342 & **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) &
2343 & **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) &
2344 & **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) &
2345 & **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) &
2346 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2347 beta_coef_y(i + 1, 1, &
2348 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2349 & **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) &
2350 & **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) &
2351 & *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) &
2352 & + 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) &
2353 & **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) &
2354 & **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) &
2355 & **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) &
2356 & **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 &
2357 & - 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 &
2358 & - 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) &
2359 & **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) &
2360 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2361 beta_coef_y(i + 1, 1, &
2362 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2363 & **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 &
2364 & + 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) &
2365 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2366 & + y(3) + y(4))**2)
2367
2368 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2369 beta_coef_y(i + 1, 0, &
2370 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2371 & **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 &
2372 & + 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) &
2373 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2374 & + y(3) + y(4))**2)
2375 beta_coef_y(i + 1, 0, &
2376 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2377 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2378 & **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) &
2379 & **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) &
2380 & + 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) &
2381 & **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 &
2382 & + 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) &
2383 & **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) &
2384 & *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 &
2385 & + 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) &
2386 & + 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) &
2387 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2388 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2389 beta_coef_y(i + 1, 0, &
2390 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2391 & *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) &
2392 & + 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) &
2393 & **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) &
2394 & + 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) &
2395 & *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) &
2396 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2397 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2398 beta_coef_y(i + 1, 0, &
2399 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2400 & **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) &
2401 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2402 & + 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) &
2403 & + 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) &
2404 & *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) &
2405 & *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) &
2406 & + 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) &
2407 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2408 & + 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) &
2409 & **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) &
2410 & **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) &
2411 & *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) &
2412 & **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) &
2413 & **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 &
2414 & + 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) &
2415 & + 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 &
2416 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2417 & + 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) &
2418 & **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) &
2419 & **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) &
2420 & **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)) &
2421 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2422 beta_coef_y(i + 1, 0, &
2423 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
2424 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
2425 & **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) &
2426 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
2427 & **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) &
2428 & **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) &
2429 & **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) &
2430 & + 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) &
2431 & + 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) &
2432 & + 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) &
2433 & *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 &
2434 & + 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) &
2435 & *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) &
2436 & + 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) &
2437 & **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)) &
2438 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2439 & + y(4))**2)
2440 beta_coef_y(i + 1, 0, &
2441 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
2442 & **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) &
2443 & + 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) &
2444 & *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 &
2445 & + 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) &
2446 & **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) &
2447 & + 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) &
2448 & **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) &
2449 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2450 & + y(3) + y(4))**2)
2451 end do
2452 else
2453 ! (Fu, et al., 2016) Table 2 (for right flux)
2454 d_cbl_y(0,:) = 18._wp/35._wp
2455 d_cbl_y(1,:) = 3._wp/35._wp
2456 d_cbl_y(2,:) = 9._wp/35._wp
2457 d_cbl_y(3,:) = 1._wp/35._wp
2458 d_cbl_y(4,:) = 4._wp/35._wp
2459
2460 d_cbr_y(0,:) = 18._wp/35._wp
2461 d_cbr_y(1,:) = 9._wp/35._wp
2462 d_cbr_y(2,:) = 3._wp/35._wp
2463 d_cbr_y(3,:) = 4._wp/35._wp
2464 d_cbr_y(4,:) = 1._wp/35._wp
2465 end if
2466 end if
2467 end if
2468# 192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2469 ! Computing WENO3 Coefficients
2470 if (weno_dir == 3) then
2471 if (weno_order == 3) then
2472 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2473 ! Polynomial reconstruction coefficients
2474 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
2475 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
2476
2477 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
2478 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
2479
2480 ! Ideal (linear) weights
2481 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
2482 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
2483
2484 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
2485 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
2486
2487 ! Smoothness indicator coefficients
2488 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
2489 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
2490 end do
2491
2492 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2493 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2494 if (null_weights) then
2495 if (bc_s%beg == bc_riemann_extrap) then
2496 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2497 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2498 end if
2499
2500 if (bc_s%end == bc_riemann_extrap) then
2501 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
2502 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
2503 end if
2504 end if
2505 ! END: Computing WENO3 Coefficients
2506
2507 ! Computing WENO5 Coefficients
2508 else if (weno_order == 5) then
2509 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2510 ! Polynomial reconstruction coefficients
2511 poly_coef_cbr_z(i + 1, 0, &
2512 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
2513 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2514 poly_coef_cbr_z(i + 1, 1, &
2515 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
2516 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
2517 poly_coef_cbr_z(i + 1, 1, &
2518 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
2519 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2520 poly_coef_cbr_z(i + 1, 2, &
2521 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2522 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2523 poly_coef_cbl_z(i + 1, 0, &
2524 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
2525 & *(s_cb(i + 3) - s_cb(i + 1)))
2526 poly_coef_cbl_z(i + 1, 1, &
2527 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
2528 & + 2))*(s_cb(i) - s_cb(i + 2)))
2529 poly_coef_cbl_z(i + 1, 1, &
2530 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
2531 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2532 poly_coef_cbl_z(i + 1, 2, &
2533 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
2534 & *(s_cb(i - 2) - s_cb(i + 1)))
2535
2536 poly_coef_cbr_z(i + 1, 0, &
2537 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
2538 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
2539 poly_coef_cbr_z(i + 1, 2, &
2540 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
2541 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
2542 poly_coef_cbl_z(i + 1, 0, &
2543 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
2544 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
2545 poly_coef_cbl_z(i + 1, 2, &
2546 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
2547 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
2548
2549 ! Ideal (linear) weights
2550 d_cbr_z(0, &
2551 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2552 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2553 d_cbr_z(2, &
2554 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
2555 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2556 d_cbl_z(0, &
2557 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
2558 & *(s_cb(i + 3) - s_cb(i - 1)))
2559 d_cbl_z(2, &
2560 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
2561 & *(s_cb(i - 2) - s_cb(i + 3)))
2562
2563 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2564 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2565
2566 ! Smoothness indicator coefficients
2567 beta_coef_z(i + 1, 0, &
2568 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2569 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2570 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2571
2572 beta_coef_z(i + 1, 0, &
2573 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2574 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
2575 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
2576 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
2577
2578 beta_coef_z(i + 1, 0, &
2579 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2580 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
2581 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
2582 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2583
2584 beta_coef_z(i + 1, 1, &
2585 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2586 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2587 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2588
2589 beta_coef_z(i + 1, 1, &
2590 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
2591 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
2592 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
2593 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
2594
2595 beta_coef_z(i + 1, 1, &
2596 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2597 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2598 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
2599
2600 beta_coef_z(i + 1, 2, &
2601 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2602 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
2603 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
2604 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
2605
2606 beta_coef_z(i + 1, 2, &
2607 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2608 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
2609 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
2610 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
2611
2612 beta_coef_z(i + 1, 2, &
2613 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2614 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2615 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2616 end do
2617
2618 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2619 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2620 if (null_weights) then
2621 if (bc_s%beg == bc_riemann_extrap) then
2622 d_cbr_z(1:2,0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2623 d_cbl_z(1:2,0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2624 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:,1) = d_cbr_z(:,1)/sum(d_cbr_z(:,1))
2625 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:,1) = d_cbl_z(:,1)/sum(d_cbl_z(:,1))
2626 end if
2627
2628 if (bc_s%end == bc_riemann_extrap) then
2629 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:,s - 1) = d_cbr_z(:, &
2630 & s - 1)/sum(d_cbr_z(:,s - 1))
2631 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:,s - 1) = d_cbl_z(:, &
2632 & s - 1)/sum(d_cbl_z(:,s - 1))
2633 d_cbr_z(0:1,s) = 0._wp; d_cbr_z(2, s) = 1._wp
2634 d_cbl_z(0:1,s) = 0._wp; d_cbl_z(2, s) = 1._wp
2635 end if
2636 end if
2637 else
2638 if (.not. teno) then
2639 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2640 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
2641 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
2642 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
2643 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
2644 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
2645 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2646 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
2647 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
2648 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
2649 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
2650 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2651
2652 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2653 d_cbr_z(0, &
2654 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2655 & *(w(1) - w(8)))
2656 d_cbr_z(1, &
2657 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2658 & *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) &
2659 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2660 & *(w(2) - w(8)))
2661 d_cbr_z(2, &
2662 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2663 & *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) &
2664 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2665 & *(w(3) - w(8)))
2666 d_cbr_z(3, &
2667 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2668 & *(w(3) - w(8)))
2669
2670 ! Element-wise on purpose - do NOT rewrite as a reversed-stride section (e.g. s_cb(i+1:i-2:-1)):
2671 ! negative-stride sections of descriptor arrays lower to address arithmetic whose no-wrap
2672 ! (nuw) claims are false, which amdflang (AFAR drop-23.2.x, flang PR #184573; fixed upstream
2673 ! in #198014) turns into silently wrong WENO7 coefficients at -O2/-O3.
2674 w(1) = s_cb(i + 4) - s_cb(i)
2675 w(2) = s_cb(i + 3) - s_cb(i)
2676 w(3) = s_cb(i + 2) - s_cb(i)
2677 w(4) = s_cb(i + 1) - s_cb(i)
2678 w(5) = s_cb(i) - s_cb(i)
2679 w(6) = s_cb(i - 1) - s_cb(i)
2680 w(7) = s_cb(i - 2) - s_cb(i)
2681 w(8) = s_cb(i - 3) - s_cb(i)
2682 d_cbl_z(0, &
2683 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2684 & *(w(3) - w(8)))
2685 d_cbl_z(1, &
2686 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2687 & *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) &
2688 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2689 & *(w(3) - w(8)))
2690 d_cbl_z(2, &
2691 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2692 & *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) &
2693 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2694 & *(w(2) - w(8)))
2695 d_cbl_z(3, &
2696 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2697 & *(w(1) - w(8)))
2698 ! Note: Left has the reversed order of both points and coefficients compared to the right
2699
2700 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2701 poly_coef_cbr_z(i + 1, 0, &
2702 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2703 & + y(2) + y(3) + y(4)))
2704 poly_coef_cbr_z(i + 1, 0, &
2705 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2706 & + 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) &
2707 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2708 poly_coef_cbr_z(i + 1, 0, &
2709 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2710 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2711 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2712
2713 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2714 poly_coef_cbr_z(i + 1, 1, &
2715 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2716 & + y(2) + y(3) + y(4)))
2717 poly_coef_cbr_z(i + 1, 1, &
2718 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2719 & + 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) &
2720 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2721 poly_coef_cbr_z(i + 1, 1, &
2722 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2723 & + y(2) + y(3) + y(4)))
2724
2725 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2726 poly_coef_cbr_z(i + 1, 2, &
2727 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2728 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2729 poly_coef_cbr_z(i + 1, 2, &
2730 & 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 &
2731 & + 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) &
2732 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2733 poly_coef_cbr_z(i + 1, 2, &
2734 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2735 & + y(2) + y(3) + y(4)))
2736
2737 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2738 poly_coef_cbr_z(i + 1, 3, &
2739 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2740 & + 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) &
2741 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2742 poly_coef_cbr_z(i + 1, 3, &
2743 & 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) &
2744 & + 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)) &
2745 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2746 & + y(4)))
2747 poly_coef_cbr_z(i + 1, 3, &
2748 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2749 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2750
2751 ! Element-wise: see the no-reversed-sections note above.
2752 y(1) = s_cb(i + 1) - s_cb(i)
2753 y(2) = s_cb(i) - s_cb(i - 1)
2754 y(3) = s_cb(i - 1) - s_cb(i - 2)
2755 y(4) = s_cb(i - 2) - s_cb(i - 3)
2756 poly_coef_cbl_z(i + 1, 3, &
2757 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2758 & + y(2) + y(3) + y(4)))
2759 poly_coef_cbl_z(i + 1, 3, &
2760 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2761 & + 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) &
2762 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2763 poly_coef_cbl_z(i + 1, 3, &
2764 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2765 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2766 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2767
2768 ! Element-wise: see the no-reversed-sections note above.
2769 y(1) = s_cb(i + 2) - s_cb(i + 1)
2770 y(2) = s_cb(i + 1) - s_cb(i)
2771 y(3) = s_cb(i) - s_cb(i - 1)
2772 y(4) = s_cb(i - 1) - s_cb(i - 2)
2773 poly_coef_cbl_z(i + 1, 2, &
2774 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2775 & + y(2) + y(3) + y(4)))
2776 poly_coef_cbl_z(i + 1, 2, &
2777 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2778 & + 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) &
2779 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2780 poly_coef_cbl_z(i + 1, 2, &
2781 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2782 & + y(2) + y(3) + y(4)))
2783
2784 ! Element-wise: see the no-reversed-sections note above.
2785 y(1) = s_cb(i + 3) - s_cb(i + 2)
2786 y(2) = s_cb(i + 2) - s_cb(i + 1)
2787 y(3) = s_cb(i + 1) - s_cb(i)
2788 y(4) = s_cb(i) - s_cb(i - 1)
2789 poly_coef_cbl_z(i + 1, 1, &
2790 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2791 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2792 poly_coef_cbl_z(i + 1, 1, &
2793 & 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 &
2794 & + 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) &
2795 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2796 poly_coef_cbl_z(i + 1, 1, &
2797 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2798 & + y(2) + y(3) + y(4)))
2799
2800 ! Element-wise: see the no-reversed-sections note above.
2801 y(1) = s_cb(i + 4) - s_cb(i + 3)
2802 y(2) = s_cb(i + 3) - s_cb(i + 2)
2803 y(3) = s_cb(i + 2) - s_cb(i + 1)
2804 y(4) = s_cb(i + 1) - s_cb(i)
2805 poly_coef_cbl_z(i + 1, 0, &
2806 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2807 & + 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) &
2808 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2809 poly_coef_cbl_z(i + 1, 0, &
2810 & 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) &
2811 & + 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)) &
2812 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2813 & + y(4)))
2814 poly_coef_cbl_z(i + 1, 0, &
2815 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2816 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2817
2818 poly_coef_cbl_z(i + 1,:,:) = -poly_coef_cbl_z(i + 1,:,:)
2819 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2820
2821 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2822 beta_coef_z(i + 1, 3, &
2823 & 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) &
2824 & + 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) &
2825 & **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 &
2826 & + 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) &
2827 & *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) &
2828 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2829 & + 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) &
2830 & *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) &
2831 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2832 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2833 beta_coef_z(i + 1, 3, &
2834 & 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) &
2835 & **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) &
2836 & + 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) &
2837 & + 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) &
2838 & + 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) &
2839 & *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) &
2840 & *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) &
2841 & *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) &
2842 & **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) &
2843 & **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) &
2844 & *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) &
2845 & + 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) &
2846 & *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) &
2847 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2848 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2849 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2850 beta_coef_z(i + 1, 3, &
2851 & 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) &
2852 & **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) &
2853 & + 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) &
2854 & *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 &
2855 & + 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) &
2856 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2857 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2858 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2859 beta_coef_z(i + 1, 3, &
2860 & 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 &
2861 & + 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 &
2862 & + 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 &
2863 & + 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) &
2864 & + 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) &
2865 & **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) &
2866 & **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) &
2867 & **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) &
2868 & **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) &
2869 & *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) &
2870 & **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) &
2871 & **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) &
2872 & **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) &
2873 & **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) &
2874 & **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) &
2875 & **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) &
2876 & **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) &
2877 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2878 & + 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 &
2879 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2880 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2881 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2882 & + y(3) + y(4))**2)
2883 beta_coef_z(i + 1, 3, &
2884 & 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) &
2885 & **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) &
2886 & **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) &
2887 & **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) &
2888 & *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) &
2889 & *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) &
2890 & **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) &
2891 & **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) &
2892 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2893 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2894 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2895 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2896 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2897 beta_coef_z(i + 1, 3, &
2898 & 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 &
2899 & + 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) &
2900 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2901 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2902 & + y(4))**2)
2903
2904 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2905 beta_coef_z(i + 1, 2, &
2906 & 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 &
2907 & + 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) &
2908 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2909 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2910 & + y(4))**2)
2911 beta_coef_z(i + 1, 2, &
2912 & 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 &
2913 & + 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) &
2914 & - 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 &
2915 & - 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 &
2916 & + 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 &
2917 & + 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 &
2918 & + 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 &
2919 & + 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) &
2920 & **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 &
2921 & - 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 &
2922 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2923 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2924 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2925 & **2)
2926 beta_coef_z(i + 1, 2, &
2927 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2928 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2929 & + 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) &
2930 & *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)) &
2931 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2932 & + y(4))**2)
2933 beta_coef_z(i + 1, 2, &
2934 & 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 &
2935 & + 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 &
2936 & + 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 &
2937 & + 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) &
2938 & + 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) &
2939 & **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) &
2940 & **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) &
2941 & **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) &
2942 & **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) &
2943 & *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 &
2944 & + 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) &
2945 & **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 &
2946 & + 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 &
2947 & + 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) &
2948 & **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) &
2949 & *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) &
2950 & + 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 &
2951 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2952 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2953 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2954 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2955 & + y(3) + y(4))**2)
2956 beta_coef_z(i + 1, 2, &
2957 & 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) &
2958 & **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) &
2959 & *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) &
2960 & *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) &
2961 & *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) &
2962 & **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) &
2963 & **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) &
2964 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2965 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2966 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2967 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2968 & **2)
2969 beta_coef_z(i + 1, 2, &
2970 & 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 &
2971 & - 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)) &
2972 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2973
2974 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2975 beta_coef_z(i + 1, 1, &
2976 & 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 &
2977 & - 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)) &
2978 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2979 beta_coef_z(i + 1, 1, &
2980 & 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) &
2981 & *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) &
2982 & **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) &
2983 & **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) &
2984 & **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) &
2985 & **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) &
2986 & **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) &
2987 & *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) &
2988 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2989 & **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) &
2990 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2991 & + y(3) + y(4))**2)
2992 beta_coef_z(i + 1, 1, &
2993 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2994 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2995 & + 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) &
2996 & *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)) &
2997 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2998 & + y(4))**2)
2999 beta_coef_z(i + 1, 1, &
3000 & 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) &
3001 & + 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) &
3002 & **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) &
3003 & **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) &
3004 & **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) &
3005 & **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) &
3006 & + 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) &
3007 & **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) &
3008 & **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) &
3009 & **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) &
3010 & **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) &
3011 & - 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) &
3012 & **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) &
3013 & **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) &
3014 & *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) &
3015 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
3016 & **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) &
3017 & **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) &
3018 & **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) &
3019 & **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) &
3020 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3021 beta_coef_z(i + 1, 1, &
3022 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
3023 & **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) &
3024 & **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) &
3025 & *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) &
3026 & + 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) &
3027 & **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) &
3028 & **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) &
3029 & **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) &
3030 & **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 &
3031 & - 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 &
3032 & - 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) &
3033 & **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) &
3034 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3035 beta_coef_z(i + 1, 1, &
3036 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
3037 & **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 &
3038 & + 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) &
3039 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3040 & + y(3) + y(4))**2)
3041
3042 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
3043 beta_coef_z(i + 1, 0, &
3044 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
3045 & **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 &
3046 & + 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) &
3047 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
3048 & + y(3) + y(4))**2)
3049 beta_coef_z(i + 1, 0, &
3050 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
3051 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
3052 & **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) &
3053 & **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) &
3054 & + 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) &
3055 & **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 &
3056 & + 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) &
3057 & **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) &
3058 & *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 &
3059 & + 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) &
3060 & + 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) &
3061 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
3062 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3063 beta_coef_z(i + 1, 0, &
3064 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
3065 & *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) &
3066 & + 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) &
3067 & **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) &
3068 & + 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) &
3069 & *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) &
3070 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
3071 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3072 beta_coef_z(i + 1, 0, &
3073 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
3074 & **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) &
3075 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
3076 & + 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) &
3077 & + 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) &
3078 & *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) &
3079 & *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) &
3080 & + 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) &
3081 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
3082 & + 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) &
3083 & **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) &
3084 & **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) &
3085 & *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) &
3086 & **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) &
3087 & **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 &
3088 & + 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) &
3089 & + 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 &
3090 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
3091 & + 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) &
3092 & **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) &
3093 & **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) &
3094 & **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)) &
3095 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3096 beta_coef_z(i + 1, 0, &
3097 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
3098 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
3099 & **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) &
3100 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
3101 & **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) &
3102 & **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) &
3103 & **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) &
3104 & + 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) &
3105 & + 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) &
3106 & + 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) &
3107 & *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 &
3108 & + 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) &
3109 & *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) &
3110 & + 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) &
3111 & **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)) &
3112 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
3113 & + y(4))**2)
3114 beta_coef_z(i + 1, 0, &
3115 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
3116 & **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) &
3117 & + 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) &
3118 & *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 &
3119 & + 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) &
3120 & **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) &
3121 & + 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) &
3122 & **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) &
3123 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3124 & + y(3) + y(4))**2)
3125 end do
3126 else
3127 ! (Fu, et al., 2016) Table 2 (for right flux)
3128 d_cbl_z(0,:) = 18._wp/35._wp
3129 d_cbl_z(1,:) = 3._wp/35._wp
3130 d_cbl_z(2,:) = 9._wp/35._wp
3131 d_cbl_z(3,:) = 1._wp/35._wp
3132 d_cbl_z(4,:) = 4._wp/35._wp
3133
3134 d_cbr_z(0,:) = 18._wp/35._wp
3135 d_cbr_z(1,:) = 9._wp/35._wp
3136 d_cbr_z(2,:) = 3._wp/35._wp
3137 d_cbr_z(3,:) = 4._wp/35._wp
3138 d_cbr_z(4,:) = 1._wp/35._wp
3139 end if
3140 end if
3141 end if
3142# 866 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3143
3144 ! Detect whether grid spacing is uniform (enables cancellation-free sum-of-squares beta). Tolerance uses sqrt(epsilon) so it
3145 ! works in both double and single precision: ~1.5e-8 relative in double, ~3.5e-4 in single - above FP noise, below real
3146 ! stretching.
3147 uniform_grid(weno_dir) = .true.
3148 h0 = (s_cb(s) - s_cb(0))/real(s, wp)
3149 do i = 0, s - 1
3150 if (abs((s_cb(i + 1) - s_cb(i)) - h0) > sqrt(epsilon(h0))*abs(h0)) then
3151 uniform_grid(weno_dir) = .false.
3152 exit
3153 end if
3154 end do
3155
3156 if (weno_dir == 1) then
3157
3158# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3159#if defined(MFC_OpenACC)
3160# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3161!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3162# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3163#elif defined(MFC_OpenMP)
3164# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3165!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3166# 880 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3167#endif
3168 else if (weno_dir == 2) then
3169
3170# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3171#if defined(MFC_OpenACC)
3172# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3173!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3174# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3175#elif defined(MFC_OpenMP)
3176# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3177!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3178# 882 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3179#endif
3180 else
3181
3182# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3183#if defined(MFC_OpenACC)
3184# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3185!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3186# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3187#elif defined(MFC_OpenMP)
3188# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3189!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3190# 884 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3191#endif
3192 end if
3193
3194 ! Nullifying WENO coefficients and cell-boundary locations pointers
3195
3196 nullify (s_cb)
3197
3198 end subroutine s_compute_weno_coefficients
3199
3200 subroutine s_pack_weno_input_arr(v_vf)
3201
3202 type(scalar_field), dimension(1:), intent(in) :: v_vf
3203 integer :: i, j, k, l, n_vars
3204
3205
3206# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3207
3208# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3209#if defined(MFC_OpenACC)
3210# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3211!$acc parallel loop collapse(4) gang vector default(present)
3212# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3213#elif defined(MFC_OpenMP)
3214# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3215
3216# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3217
3218# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3219
3220# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3221!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3222# 898 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3223#endif
3224 do i = 1, v_size
3225 do l = idwbuff(3)%beg, idwbuff(3)%end
3226 do k = idwbuff(2)%beg, idwbuff(2)%end
3227 do j = idwbuff(1)%beg, idwbuff(1)%end
3228 v_rs_weno(j, k, l, i) = v_vf(i)%sf(j, k, l)
3229 end do
3230 end do
3231 end do
3232 end do
3233
3234# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3235#if defined(MFC_OpenACC)
3236# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3237!$acc end parallel loop
3238# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3239#elif defined(MFC_OpenMP)
3240# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3241
3242# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3243!$omp end target teams loop
3244# 908 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3245#endif
3246
3247 end subroutine s_pack_weno_input_arr
3248
3249 !> Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables
3250 subroutine s_weno(v_vf, vL_rs_vf_x, vR_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
3251
3252 type(scalar_field), dimension(1:), intent(in) :: v_vf
3253 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x
3254 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vr_rs_vf_x
3255 integer, intent(in) :: weno_dir
3256 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
3257
3258# 929 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3259 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
3260 real(wp), dimension(0:weno_num_stencils) :: poly
3261 real(wp), dimension(0:weno_num_stencils) :: alpha
3262 real(wp), dimension(0:weno_num_stencils) :: omega
3263 real(wp), dimension(0:weno_num_stencils) :: beta
3264 real(wp), dimension(0:weno_num_stencils) :: delta
3265# 936 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3266 real(wp), dimension(-3:3) :: v !< temporary field value array for clarity (WENO7 only)
3267 real(wp) :: tau
3268 integer :: i, j, k, l, q
3269 real(wp) :: vp0, vp1, vp2, vp3, vm1, vm2, vm3
3270
3271 is1_weno = is1_weno_d
3272 is2_weno = is2_weno_d
3273 is3_weno = is3_weno_d
3274
3275
3276# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3277#if defined(MFC_OpenACC)
3278# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3279!$acc update device(is1_weno, is2_weno, is3_weno)
3280# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3281#elif defined(MFC_OpenMP)
3282# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3283!$omp target update to(is1_weno, is2_weno, is3_weno)
3284# 945 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3285#endif
3286
3287 v_size = ubound(v_vf, 1)
3288
3289# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3290#if defined(MFC_OpenACC)
3291# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3292!$acc update device(v_size)
3293# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3294#elif defined(MFC_OpenMP)
3295# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3296!$omp target update to(v_size)
3297# 948 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3298#endif
3299
3300 if (weno_order == 1) then
3301 if (weno_dir == 1) then
3302
3303# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3304
3305# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3306#if defined(MFC_OpenACC)
3307# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3308!$acc parallel loop collapse(4) gang vector default(present)
3309# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3310#elif defined(MFC_OpenMP)
3311# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3312
3313# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3314
3315# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3316
3317# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3318!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3319# 952 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3320#endif
3321 do i = 1, v_size
3322 do l = is3_weno%beg, is3_weno%end
3323 do k = is2_weno%beg, is2_weno%end
3324 do j = is1_weno%beg, is1_weno%end
3325 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3326 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3327 end do
3328 end do
3329 end do
3330 end do
3331
3332# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3333#if defined(MFC_OpenACC)
3334# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3335!$acc end parallel loop
3336# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3337#elif defined(MFC_OpenMP)
3338# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3339
3340# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3341!$omp end target teams loop
3342# 963 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3343#endif
3344 else if (weno_dir == 2) then
3345
3346# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3347
3348# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3349#if defined(MFC_OpenACC)
3350# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3351!$acc parallel loop collapse(4) gang vector default(present)
3352# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3353#elif defined(MFC_OpenMP)
3354# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3355
3356# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3357
3358# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3359
3360# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3361!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3362# 965 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3363#endif
3364 do i = 1, v_size
3365 do l = is3_weno%beg, is3_weno%end
3366 do j = is1_weno%beg, is1_weno%end
3367 do k = is2_weno%beg, is2_weno%end
3368 vl_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3369 vr_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3370 end do
3371 end do
3372 end do
3373 end do
3374
3375# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3376#if defined(MFC_OpenACC)
3377# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3378!$acc end parallel loop
3379# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3380#elif defined(MFC_OpenMP)
3381# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3382
3383# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3384!$omp end target teams loop
3385# 976 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3386#endif
3387 else if (weno_dir == 3) then
3388
3389# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3390
3391# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3392#if defined(MFC_OpenACC)
3393# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3394!$acc parallel loop collapse(4) gang vector default(present)
3395# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3396#elif defined(MFC_OpenMP)
3397# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3398
3399# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3400
3401# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3402
3403# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3404!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3405# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3406#endif
3407 do i = 1, v_size
3408 do j = is1_weno%beg, is1_weno%end
3409 do k = is2_weno%beg, is2_weno%end
3410 do l = is3_weno%beg, is3_weno%end
3411 vl_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3412 vr_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3413 end do
3414 end do
3415 end do
3416 end do
3417
3418# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3419#if defined(MFC_OpenACC)
3420# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3421!$acc end parallel loop
3422# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3423#elif defined(MFC_OpenMP)
3424# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3425
3426# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3427!$omp end target teams loop
3428# 989 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3429#endif
3430 end if
3431 end if
3432
3433 if (weno_order /= 1) then
3434 call s_pack_weno_input_arr(v_vf)
3435 end if
3436
3437 if (weno_order == 3) then
3438# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3439# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3440# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3441 if (weno_dir == 1) then
3442
3443# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3444
3445# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3446#if defined(MFC_OpenACC)
3447# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3448!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3449# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3450#elif defined(MFC_OpenMP)
3451# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3452
3453# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3454
3455# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3456
3457# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3458!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3459# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3460!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3461# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3462#endif
3463 do l = is3_weno%beg, is3_weno%end
3464 do k = is2_weno%beg, is2_weno%end
3465 do j = is1_weno%beg, is1_weno%end
3466 do i = 1, v_size
3467 ! reconstruct from left side
3468
3469 alpha(:) = 0._wp
3470
3471 vp0 = v_rs_weno(j, k, l, i)
3472 vm1 = v_rs_weno(j - 1, k, l, i)
3473 vp1 = v_rs_weno(j + 1, k, l, i)
3474
3475 dvd(0) = vp1 - vp0
3476 dvd(-1) = vp0 - vm1
3477
3478 poly(0) = vp0 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
3479 poly(1) = vp0 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
3480
3481 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3482 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3483
3484 if (wenojs) then
3485 do q = 0, weno_num_stencils
3486 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3487 end do
3488 else if (mapped_weno) then
3489 do q = 0, weno_num_stencils
3490 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3491 end do
3492 omega = alpha/sum(alpha)
3493 do q = 0, weno_num_stencils
3494 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3495 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3496 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3497 end do
3498 else if (wenoz) then
3499 ! Borges, et al. (2008)
3500 tau = abs(beta(1) - beta(0))
3501 do q = 0, weno_num_stencils
3502 alpha(q) = d_cbl_x(q, j)*(1._wp + tau/beta(q))
3503 end do
3504 end if
3505 omega = alpha/sum(alpha)
3506
3507 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3508
3509 ! reconstruct from right side
3510
3511 poly(0) = vp0 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3512 poly(1) = vp0 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3513
3514 if (wenojs) then
3515 do q = 0, weno_num_stencils
3516 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3517 end do
3518 else if (mapped_weno) then
3519 do q = 0, weno_num_stencils
3520 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3521 end do
3522 omega = alpha/sum(alpha)
3523 do q = 0, weno_num_stencils
3524 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3525 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3526 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3527 end do
3528 else if (wenoz) then
3529 do q = 0, weno_num_stencils
3530 alpha(q) = d_cbr_x(q, j)*(1._wp + tau/beta(q))
3531 end do
3532 end if
3533 omega = alpha/sum(alpha)
3534
3535 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3536 end do
3537 end do
3538 end do
3539 end do
3540
3541# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3542#if defined(MFC_OpenACC)
3543# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3544!$acc end parallel loop
3545# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3546#elif defined(MFC_OpenMP)
3547# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3548
3549# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3550!$omp end target teams loop
3551# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3552#endif
3553 end if
3554# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3555# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3556# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3557 if (weno_dir == 2) then
3558
3559# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3560
3561# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3562#if defined(MFC_OpenACC)
3563# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3564!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3565# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3566#elif defined(MFC_OpenMP)
3567# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3568
3569# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3570
3571# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3572
3573# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3574!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3575# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3576!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3577# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3578#endif
3579 do l = is3_weno%beg, is3_weno%end
3580 do k = is1_weno%beg, is1_weno%end
3581 do j = is2_weno%beg, is2_weno%end
3582 do i = 1, v_size
3583 ! reconstruct from left side
3584
3585 alpha(:) = 0._wp
3586
3587 vp0 = v_rs_weno(j, k, l, i)
3588 vm1 = v_rs_weno(j, k - 1, l, i)
3589 vp1 = v_rs_weno(j, k + 1, l, i)
3590
3591 dvd(0) = vp1 - vp0
3592 dvd(-1) = vp0 - vm1
3593
3594 poly(0) = vp0 + poly_coef_cbl_y(k, 0, 0)*dvd(0)
3595 poly(1) = vp0 + poly_coef_cbl_y(k, 1, 0)*dvd(-1)
3596
3597 beta(0) = beta_coef_y(k, 0, 0)*dvd(0)*dvd(0) + weno_eps
3598 beta(1) = beta_coef_y(k, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3599
3600 if (wenojs) then
3601 do q = 0, weno_num_stencils
3602 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3603 end do
3604 else if (mapped_weno) then
3605 do q = 0, weno_num_stencils
3606 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3607 end do
3608 omega = alpha/sum(alpha)
3609 do q = 0, weno_num_stencils
3610 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
3611 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3612 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
3613 end do
3614 else if (wenoz) then
3615 ! Borges, et al. (2008)
3616 tau = abs(beta(1) - beta(0))
3617 do q = 0, weno_num_stencils
3618 alpha(q) = d_cbl_y(q, k)*(1._wp + tau/beta(q))
3619 end do
3620 end if
3621 omega = alpha/sum(alpha)
3622
3623 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3624
3625 ! reconstruct from right side
3626
3627 poly(0) = vp0 + poly_coef_cbr_y(k, 0, 0)*dvd(0)
3628 poly(1) = vp0 + poly_coef_cbr_y(k, 1, 0)*dvd(-1)
3629
3630 if (wenojs) then
3631 do q = 0, weno_num_stencils
3632 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3633 end do
3634 else if (mapped_weno) then
3635 do q = 0, weno_num_stencils
3636 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3637 end do
3638 omega = alpha/sum(alpha)
3639 do q = 0, weno_num_stencils
3640 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
3641 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
3642 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
3643 end do
3644 else if (wenoz) then
3645 do q = 0, weno_num_stencils
3646 alpha(q) = d_cbr_y(q, k)*(1._wp + tau/beta(q))
3647 end do
3648 end if
3649 omega = alpha/sum(alpha)
3650
3651 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3652 end do
3653 end do
3654 end do
3655 end do
3656
3657# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3658#if defined(MFC_OpenACC)
3659# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3660!$acc end parallel loop
3661# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3662#elif defined(MFC_OpenMP)
3663# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3664
3665# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3666!$omp end target teams loop
3667# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3668#endif
3669 end if
3670# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3671# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3672# 1004 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3673 if (weno_dir == 3) then
3674
3675# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3676
3677# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3678#if defined(MFC_OpenACC)
3679# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3680!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3681# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3682#elif defined(MFC_OpenMP)
3683# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3684
3685# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3686
3687# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3688
3689# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3690!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3691# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3692!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3693# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3694#endif
3695 do l = is1_weno%beg, is1_weno%end
3696 do k = is2_weno%beg, is2_weno%end
3697 do j = is3_weno%beg, is3_weno%end
3698 do i = 1, v_size
3699 ! reconstruct from left side
3700
3701 alpha(:) = 0._wp
3702
3703 vp0 = v_rs_weno(j, k, l, i)
3704 vm1 = v_rs_weno(j, k, l - 1, i)
3705 vp1 = v_rs_weno(j, k, l + 1, i)
3706
3707 dvd(0) = vp1 - vp0
3708 dvd(-1) = vp0 - vm1
3709
3710 poly(0) = vp0 + poly_coef_cbl_z(l, 0, 0)*dvd(0)
3711 poly(1) = vp0 + poly_coef_cbl_z(l, 1, 0)*dvd(-1)
3712
3713 beta(0) = beta_coef_z(l, 0, 0)*dvd(0)*dvd(0) + weno_eps
3714 beta(1) = beta_coef_z(l, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3715
3716 if (wenojs) then
3717 do q = 0, weno_num_stencils
3718 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3719 end do
3720 else if (mapped_weno) then
3721 do q = 0, weno_num_stencils
3722 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3723 end do
3724 omega = alpha/sum(alpha)
3725 do q = 0, weno_num_stencils
3726 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
3727 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
3728 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
3729 end do
3730 else if (wenoz) then
3731 ! Borges, et al. (2008)
3732 tau = abs(beta(1) - beta(0))
3733 do q = 0, weno_num_stencils
3734 alpha(q) = d_cbl_z(q, l)*(1._wp + tau/beta(q))
3735 end do
3736 end if
3737 omega = alpha/sum(alpha)
3738
3739 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3740
3741 ! reconstruct from right side
3742
3743 poly(0) = vp0 + poly_coef_cbr_z(l, 0, 0)*dvd(0)
3744 poly(1) = vp0 + poly_coef_cbr_z(l, 1, 0)*dvd(-1)
3745
3746 if (wenojs) then
3747 do q = 0, weno_num_stencils
3748 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3749 end do
3750 else if (mapped_weno) then
3751 do q = 0, weno_num_stencils
3752 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3753 end do
3754 omega = alpha/sum(alpha)
3755 do q = 0, weno_num_stencils
3756 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
3757 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
3758 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
3759 end do
3760 else if (wenoz) then
3761 do q = 0, weno_num_stencils
3762 alpha(q) = d_cbr_z(q, l)*(1._wp + tau/beta(q))
3763 end do
3764 end if
3765 omega = alpha/sum(alpha)
3766
3767 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3768 end do
3769 end do
3770 end do
3771 end do
3772
3773# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3774#if defined(MFC_OpenACC)
3775# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3776!$acc end parallel loop
3777# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3778#elif defined(MFC_OpenMP)
3779# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3780
3781# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3782!$omp end target teams loop
3783# 1083 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3784#endif
3785 end if
3786# 1086 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3787 end if
3788 if (weno_order == 5) then
3789# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3790# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3791# 1094 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3792# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3793 if (weno_dir == 1) then
3794
3795# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3796
3797# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3798#if defined(MFC_OpenACC)
3799# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3800!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3801# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3802#elif defined(MFC_OpenMP)
3803# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3804
3805# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3806
3807# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3808
3809# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3810!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3811# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3812!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3813# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3814#endif
3815# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3816 do l = is3_weno%beg, is3_weno%end
3817 do k = is2_weno%beg, is2_weno%end
3818 do j = is1_weno%beg, is1_weno%end
3819
3820# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3821#if defined(MFC_OpenACC)
3822# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3823!$acc loop seq
3824# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3825#elif defined(MFC_OpenMP)
3826# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3827
3828# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3829#endif
3830 do i = 1, v_size
3831 ! reconstruct from left side
3832
3833 alpha(:) = 0._wp
3834
3835 vp0 = v_rs_weno(j, k, l, i)
3836 vm1 = v_rs_weno(j - 1, k, l, i)
3837 vm2 = v_rs_weno(j - 2, k, l, i)
3838 vp1 = v_rs_weno(j + 1, k, l, i)
3839 vp2 = v_rs_weno(j + 2, k, l, i)
3840
3841 dvd(1) = vp2 - vp1
3842 dvd(0) = vp1 - vp0
3843 dvd(-1) = vp0 - vm1
3844 dvd(-2) = vm1 - vm2
3845
3846 poly(0) = vp0 + poly_coef_cbl_x(j, 0, &
3847 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3848 poly(1) = vp0 + poly_coef_cbl_x(j, 1, &
3849 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3850 poly(2) = vp0 + poly_coef_cbl_x(j, 2, &
3851 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3852
3853 if (uniform_grid(1)) then
3854 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
3855 & + weno_eps
3856 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
3857 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
3858 & + weno_eps
3859 else
3860 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
3861 & 0, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3862 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
3863 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, &
3864 & 2)*dvd(-1)*dvd(-1) + weno_eps
3865 beta(2) = beta_coef_x(j, 2, &
3866 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3867 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3868 end if
3869
3870 if (wenojs) then
3871 do q = 0, weno_num_stencils
3872 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3873 end do
3874 else if (mapped_weno) then
3875 do q = 0, weno_num_stencils
3876 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3877 end do
3878 omega = alpha/sum(alpha)
3879 do q = 0, weno_num_stencils
3880 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3881 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3882 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3883 end do
3884 else if (wenoz) then
3885 ! Borges, et al. (2008)
3886
3887 tau = abs(beta(2) - beta(0)) ! Equation 25
3888
3889# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3890#if defined(MFC_OpenACC)
3891# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3892!$acc loop seq
3893# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3894#elif defined(MFC_OpenMP)
3895# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3896
3897# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3898#endif
3899 do q = 0, weno_num_stencils
3900 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3901 ! Equation 28 (note: weno_eps was already added to beta)
3902 end do
3903 else if (teno) then
3904 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3905 tau = abs(beta(2) - beta(0))
3906
3907# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3908#if defined(MFC_OpenACC)
3909# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3910!$acc loop seq
3911# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3912#elif defined(MFC_OpenMP)
3913# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3914
3915# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3916#endif
3917 do q = 0, weno_num_stencils
3918 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3919 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3920 alpha(q) = (alpha(q)**3._wp)**2._wp
3921 end do
3922 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3923
3924
3925# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3926#if defined(MFC_OpenACC)
3927# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3928!$acc loop seq
3929# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3930#elif defined(MFC_OpenMP)
3931# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3932
3933# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3934#endif
3935 do q = 0, weno_num_stencils
3936 if (omega(q) < teno_ct) then ! Equation 26
3937 delta(q) = 0._wp
3938 else
3939 delta(q) = 1._wp
3940 end if
3941 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3942 end do
3943 end if
3944
3945 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3946 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3947 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3948
3949 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3950
3951 ! reconstruct from right side
3952
3953 poly(0) = vp0 + poly_coef_cbr_x(j, 0, &
3954 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3955 poly(1) = vp0 + poly_coef_cbr_x(j, 1, &
3956 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3957 poly(2) = vp0 + poly_coef_cbr_x(j, 2, &
3958 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3959
3960 if (wenojs) then
3961 do q = 0, weno_num_stencils
3962 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3963 end do
3964 else if (mapped_weno) then
3965 do q = 0, weno_num_stencils
3966 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3967 end do
3968 omega = alpha/sum(alpha)
3969 do q = 0, weno_num_stencils
3970 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3971 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3972 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3973 end do
3974 else if (wenoz) then
3975
3976# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3977#if defined(MFC_OpenACC)
3978# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3979!$acc loop seq
3980# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3981#elif defined(MFC_OpenMP)
3982# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3983
3984# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3985#endif
3986 do q = 0, weno_num_stencils
3987 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3988 end do
3989 else if (teno) then
3990
3991# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3992#if defined(MFC_OpenACC)
3993# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3994!$acc loop seq
3995# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3996#elif defined(MFC_OpenMP)
3997# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3998
3999# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4000#endif
4001 do q = 0, weno_num_stencils
4002 alpha(q) = delta(q)*d_cbr_x(q, j)
4003 end do
4004 end if
4005
4006 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4007 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4008 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4009
4010 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4011 end do
4012 end do
4013 end do
4014 end do
4015
4016# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4017#if defined(MFC_OpenACC)
4018# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4019!$acc end parallel loop
4020# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4021#elif defined(MFC_OpenMP)
4022# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4023
4024# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4025!$omp end target teams loop
4026# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4027#endif
4028
4029 if (mp_weno) then
4030 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4031 end if
4032 end if
4033# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4034# 1094 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4035# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4036 if (weno_dir == 2) then
4037
4038# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4039
4040# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4041#if defined(MFC_OpenACC)
4042# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4043!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4044# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4045#elif defined(MFC_OpenMP)
4046# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4047
4048# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4049
4050# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4051
4052# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4053!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4054# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4055!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4056# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4057#endif
4058# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4059 do l = is3_weno%beg, is3_weno%end
4060 do k = is1_weno%beg, is1_weno%end
4061 do j = is2_weno%beg, is2_weno%end
4062
4063# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4064#if defined(MFC_OpenACC)
4065# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4066!$acc loop seq
4067# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4068#elif defined(MFC_OpenMP)
4069# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4070
4071# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4072#endif
4073 do i = 1, v_size
4074 ! reconstruct from left side
4075
4076 alpha(:) = 0._wp
4077
4078 vp0 = v_rs_weno(j, k, l, i)
4079 vm1 = v_rs_weno(j, k - 1, l, i)
4080 vm2 = v_rs_weno(j, k - 2, l, i)
4081 vp1 = v_rs_weno(j, k + 1, l, i)
4082 vp2 = v_rs_weno(j, k + 2, l, i)
4083
4084 dvd(1) = vp2 - vp1
4085 dvd(0) = vp1 - vp0
4086 dvd(-1) = vp0 - vm1
4087 dvd(-2) = vm1 - vm2
4088
4089 poly(0) = vp0 + poly_coef_cbl_y(k, 0, &
4090 & 0)*dvd(1) + poly_coef_cbl_y(k, 0, 1)*dvd(0)
4091 poly(1) = vp0 + poly_coef_cbl_y(k, 1, &
4092 & 0)*dvd(0) + poly_coef_cbl_y(k, 1, 1)*dvd(-1)
4093 poly(2) = vp0 + poly_coef_cbl_y(k, 2, &
4094 & 0)*dvd(-1) + poly_coef_cbl_y(k, 2, 1)*dvd(-2)
4095
4096 if (uniform_grid(2)) then
4097 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4098 & + weno_eps
4099 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4100 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4101 & + weno_eps
4102 else
4103 beta(0) = beta_coef_y(k, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4104 & 0, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 2)*dvd(0)*dvd(0) + weno_eps
4105 beta(1) = beta_coef_y(k, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4106 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, &
4107 & 2)*dvd(-1)*dvd(-1) + weno_eps
4108 beta(2) = beta_coef_y(k, 2, &
4109 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4110 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4111 end if
4112
4113 if (wenojs) then
4114 do q = 0, weno_num_stencils
4115 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4116 end do
4117 else if (mapped_weno) then
4118 do q = 0, weno_num_stencils
4119 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4120 end do
4121 omega = alpha/sum(alpha)
4122 do q = 0, weno_num_stencils
4123 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4124 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4125 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4126 end do
4127 else if (wenoz) then
4128 ! Borges, et al. (2008)
4129
4130 tau = abs(beta(2) - beta(0)) ! Equation 25
4131
4132# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4133#if defined(MFC_OpenACC)
4134# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4135!$acc loop seq
4136# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4137#elif defined(MFC_OpenMP)
4138# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4139
4140# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4141#endif
4142 do q = 0, weno_num_stencils
4143 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q)))
4144 ! Equation 28 (note: weno_eps was already added to beta)
4145 end do
4146 else if (teno) then
4147 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4148 tau = abs(beta(2) - beta(0))
4149
4150# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4151#if defined(MFC_OpenACC)
4152# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4153!$acc loop seq
4154# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4155#elif defined(MFC_OpenMP)
4156# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4157
4158# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4159#endif
4160 do q = 0, weno_num_stencils
4161 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4162 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4163 alpha(q) = (alpha(q)**3._wp)**2._wp
4164 end do
4165 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4166
4167
4168# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4169#if defined(MFC_OpenACC)
4170# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4171!$acc loop seq
4172# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4173#elif defined(MFC_OpenMP)
4174# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4175
4176# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4177#endif
4178 do q = 0, weno_num_stencils
4179 if (omega(q) < teno_ct) then ! Equation 26
4180 delta(q) = 0._wp
4181 else
4182 delta(q) = 1._wp
4183 end if
4184 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4185 end do
4186 end if
4187
4188 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4189 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4190 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4191
4192 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4193
4194 ! reconstruct from right side
4195
4196 poly(0) = vp0 + poly_coef_cbr_y(k, 0, &
4197 & 0)*dvd(1) + poly_coef_cbr_y(k, 0, 1)*dvd(0)
4198 poly(1) = vp0 + poly_coef_cbr_y(k, 1, &
4199 & 0)*dvd(0) + poly_coef_cbr_y(k, 1, 1)*dvd(-1)
4200 poly(2) = vp0 + poly_coef_cbr_y(k, 2, &
4201 & 0)*dvd(-1) + poly_coef_cbr_y(k, 2, 1)*dvd(-2)
4202
4203 if (wenojs) then
4204 do q = 0, weno_num_stencils
4205 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4206 end do
4207 else if (mapped_weno) then
4208 do q = 0, weno_num_stencils
4209 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4210 end do
4211 omega = alpha/sum(alpha)
4212 do q = 0, weno_num_stencils
4213 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4214 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4215 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4216 end do
4217 else if (wenoz) then
4218
4219# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4220#if defined(MFC_OpenACC)
4221# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4222!$acc loop seq
4223# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4224#elif defined(MFC_OpenMP)
4225# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4226
4227# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4228#endif
4229 do q = 0, weno_num_stencils
4230 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q)))
4231 end do
4232 else if (teno) then
4233
4234# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4235#if defined(MFC_OpenACC)
4236# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4237!$acc loop seq
4238# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4239#elif defined(MFC_OpenMP)
4240# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4241
4242# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4243#endif
4244 do q = 0, weno_num_stencils
4245 alpha(q) = delta(q)*d_cbr_y(q, k)
4246 end do
4247 end if
4248
4249 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4250 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4251 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4252
4253 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4254 end do
4255 end do
4256 end do
4257 end do
4258
4259# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4260#if defined(MFC_OpenACC)
4261# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4262!$acc end parallel loop
4263# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4264#elif defined(MFC_OpenMP)
4265# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4266
4267# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4268!$omp end target teams loop
4269# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4270#endif
4271
4272 if (mp_weno) then
4273 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4274 end if
4275 end if
4276# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4277# 1094 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4278# 1095 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4279 if (weno_dir == 3) then
4280
4281# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4282
4283# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4284#if defined(MFC_OpenACC)
4285# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4286!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4287# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4288#elif defined(MFC_OpenMP)
4289# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4290
4291# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4292
4293# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4294
4295# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4296!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4297# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4298!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4299# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4300#endif
4301# 1098 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4302 do l = is1_weno%beg, is1_weno%end
4303 do k = is2_weno%beg, is2_weno%end
4304 do j = is3_weno%beg, is3_weno%end
4305
4306# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4307#if defined(MFC_OpenACC)
4308# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4309!$acc loop seq
4310# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4311#elif defined(MFC_OpenMP)
4312# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4313
4314# 1101 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4315#endif
4316 do i = 1, v_size
4317 ! reconstruct from left side
4318
4319 alpha(:) = 0._wp
4320
4321 vp0 = v_rs_weno(j, k, l, i)
4322 vm1 = v_rs_weno(j, k, l - 1, i)
4323 vm2 = v_rs_weno(j, k, l - 2, i)
4324 vp1 = v_rs_weno(j, k, l + 1, i)
4325 vp2 = v_rs_weno(j, k, l + 2, i)
4326
4327 dvd(1) = vp2 - vp1
4328 dvd(0) = vp1 - vp0
4329 dvd(-1) = vp0 - vm1
4330 dvd(-2) = vm1 - vm2
4331
4332 poly(0) = vp0 + poly_coef_cbl_z(l, 0, &
4333 & 0)*dvd(1) + poly_coef_cbl_z(l, 0, 1)*dvd(0)
4334 poly(1) = vp0 + poly_coef_cbl_z(l, 1, &
4335 & 0)*dvd(0) + poly_coef_cbl_z(l, 1, 1)*dvd(-1)
4336 poly(2) = vp0 + poly_coef_cbl_z(l, 2, &
4337 & 0)*dvd(-1) + poly_coef_cbl_z(l, 2, 1)*dvd(-2)
4338
4339 if (uniform_grid(3)) then
4340 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4341 & + weno_eps
4342 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4343 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4344 & + weno_eps
4345 else
4346 beta(0) = beta_coef_z(l, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
4347 & 0, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 2)*dvd(0)*dvd(0) + weno_eps
4348 beta(1) = beta_coef_z(l, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
4349 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, &
4350 & 2)*dvd(-1)*dvd(-1) + weno_eps
4351 beta(2) = beta_coef_z(l, 2, &
4352 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
4353 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4354 end if
4355
4356 if (wenojs) then
4357 do q = 0, weno_num_stencils
4358 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4359 end do
4360 else if (mapped_weno) then
4361 do q = 0, weno_num_stencils
4362 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4363 end do
4364 omega = alpha/sum(alpha)
4365 do q = 0, weno_num_stencils
4366 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
4367 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
4368 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
4369 end do
4370 else if (wenoz) then
4371 ! Borges, et al. (2008)
4372
4373 tau = abs(beta(2) - beta(0)) ! Equation 25
4374
4375# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4376#if defined(MFC_OpenACC)
4377# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4378!$acc loop seq
4379# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4380#elif defined(MFC_OpenMP)
4381# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4382
4383# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4384#endif
4385 do q = 0, weno_num_stencils
4386 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q)))
4387 ! Equation 28 (note: weno_eps was already added to beta)
4388 end do
4389 else if (teno) then
4390 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4391 tau = abs(beta(2) - beta(0))
4392
4393# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4394#if defined(MFC_OpenACC)
4395# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4396!$acc loop seq
4397# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4398#elif defined(MFC_OpenMP)
4399# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4400
4401# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4402#endif
4403 do q = 0, weno_num_stencils
4404 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4405 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4406 alpha(q) = (alpha(q)**3._wp)**2._wp
4407 end do
4408 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4409
4410
4411# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4412#if defined(MFC_OpenACC)
4413# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4414!$acc loop seq
4415# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4416#elif defined(MFC_OpenMP)
4417# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4418
4419# 1176 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4420#endif
4421 do q = 0, weno_num_stencils
4422 if (omega(q) < teno_ct) then ! Equation 26
4423 delta(q) = 0._wp
4424 else
4425 delta(q) = 1._wp
4426 end if
4427 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
4428 end do
4429 end if
4430
4431 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4432 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4433 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4434
4435 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4436
4437 ! reconstruct from right side
4438
4439 poly(0) = vp0 + poly_coef_cbr_z(l, 0, &
4440 & 0)*dvd(1) + poly_coef_cbr_z(l, 0, 1)*dvd(0)
4441 poly(1) = vp0 + poly_coef_cbr_z(l, 1, &
4442 & 0)*dvd(0) + poly_coef_cbr_z(l, 1, 1)*dvd(-1)
4443 poly(2) = vp0 + poly_coef_cbr_z(l, 2, &
4444 & 0)*dvd(-1) + poly_coef_cbr_z(l, 2, 1)*dvd(-2)
4445
4446 if (wenojs) then
4447 do q = 0, weno_num_stencils
4448 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4449 end do
4450 else if (mapped_weno) then
4451 do q = 0, weno_num_stencils
4452 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4453 end do
4454 omega = alpha/sum(alpha)
4455 do q = 0, weno_num_stencils
4456 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
4457 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
4458 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
4459 end do
4460 else if (wenoz) then
4461
4462# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4463#if defined(MFC_OpenACC)
4464# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4465!$acc loop seq
4466# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4467#elif defined(MFC_OpenMP)
4468# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4469
4470# 1217 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4471#endif
4472 do q = 0, weno_num_stencils
4473 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q)))
4474 end do
4475 else if (teno) then
4476
4477# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4478#if defined(MFC_OpenACC)
4479# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4480!$acc loop seq
4481# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4482#elif defined(MFC_OpenMP)
4483# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4484
4485# 1222 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4486#endif
4487 do q = 0, weno_num_stencils
4488 alpha(q) = delta(q)*d_cbr_z(q, l)
4489 end do
4490 end if
4491
4492 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4493 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4494 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4495
4496 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4497 end do
4498 end do
4499 end do
4500 end do
4501
4502# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4503#if defined(MFC_OpenACC)
4504# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4505!$acc end parallel loop
4506# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4507#elif defined(MFC_OpenMP)
4508# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4509
4510# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4511!$omp end target teams loop
4512# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4513#endif
4514
4515 if (mp_weno) then
4516 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4517 end if
4518 end if
4519# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4520# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4521 end if
4522 if (weno_order == 7) then
4523# 1248 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4524# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4525# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4526# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4527 if (weno_dir == 1) then
4528
4529# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4530
4531# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4532#if defined(MFC_OpenACC)
4533# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4534!$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)
4535# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4536#elif defined(MFC_OpenMP)
4537# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4538
4539# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4540
4541# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4542
4543# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4544!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4545# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4546!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4547# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4548#endif
4549# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4550 do l = is3_weno%beg, is3_weno%end
4551 do k = is2_weno%beg, is2_weno%end
4552 do j = is1_weno%beg, is1_weno%end
4553
4554# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4555#if defined(MFC_OpenACC)
4556# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4557!$acc loop seq
4558# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4559#elif defined(MFC_OpenMP)
4560# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4561
4562# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4563#endif
4564 do i = 1, v_size
4565 alpha(:) = 0._wp
4566
4567 vp0 = v_rs_weno(j, k, l, i)
4568 vm1 = v_rs_weno(j - 1, k, l, i)
4569 vm2 = v_rs_weno(j - 2, k, l, i)
4570 vm3 = v_rs_weno(j - 3, k, l, i)
4571 vp1 = v_rs_weno(j + 1, k, l, i)
4572 vp2 = v_rs_weno(j + 2, k, l, i)
4573 vp3 = v_rs_weno(j + 3, k, l, i)
4574
4575 if (teno) then
4576 v(-3) = vm3
4577 v(-2) = vm2
4578 v(-1) = vm1
4579 v(0) = vp0
4580 v(1) = vp1
4581 v(2) = vp2
4582 v(3) = vp3
4583 end if
4584
4585 if (.not. teno) then
4586 dvd(2) = vp3 - vp2
4587 dvd(1) = vp2 - vp1
4588 dvd(0) = vp1 - vp0
4589 dvd(-1) = vp0 - vm1
4590 dvd(-2) = vm1 - vm2
4591 dvd(-3) = vm2 - vm3
4592
4593 poly(3) = vp0 + poly_coef_cbl_x(j, 0, &
4594 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, &
4595 & 1)*dvd(1) + poly_coef_cbl_x(j, 0, 2)*dvd(0)
4596 poly(2) = vp0 + poly_coef_cbl_x(j, 1, &
4597 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, &
4598 & 1)*dvd(0) + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
4599 poly(1) = vp0 + poly_coef_cbl_x(j, 2, &
4600 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4601 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4602 poly(0) = vp0 + poly_coef_cbl_x(j, 3, &
4603 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4604 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4605 else
4606# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4607 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4608 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4609 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4610 ! to keep the stencil order to reuse the beta coefficients
4611 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4612 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4613 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4614 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4615 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4616# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4617 end if
4618
4619 if (.not. teno) then
4620 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, &
4621 & 0, 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4622 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4623 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4624 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4625
4626 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
4627 & 1, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4628 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4629 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4630 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4631
4632 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
4633 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4634 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4635 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4636 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4637
4638 beta(0) = beta_coef_x(j, 3, &
4639 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4640 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4641 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4642 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4643 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4644 else
4645# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4646 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4647 ! & Tang, 2019) Section 3.2
4648 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4649 & **2._wp)/4._wp + weno_eps
4650 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4651 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4652 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4653 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4654
4655 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4656 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4657 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4658
4659 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4660 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4661 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4662# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4663 end if
4664
4665 if (wenojs) then
4666 do q = 0, weno_num_stencils
4667 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4668 end do
4669 else if (mapped_weno) then
4670 do q = 0, weno_num_stencils
4671 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4672 end do
4673 omega = alpha/sum(alpha)
4674 do q = 0, weno_num_stencils
4675 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
4676 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
4677 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
4678 end do
4679 else if (wenoz) then
4680 ! Castro, et al. (2010) Don & Borges (2013) also helps
4681 tau = abs(beta(3) - beta(0)) ! Equation 50
4682
4683# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4684#if defined(MFC_OpenACC)
4685# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4686!$acc loop seq
4687# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4688#elif defined(MFC_OpenMP)
4689# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4690
4691# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4692#endif
4693 do q = 0, weno_num_stencils
4694 ! wenoz_q = 2,3,4 for stability
4695 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4696 end do
4697 else if (teno) then
4698# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4699 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4700 alpha = 1._wp + tau/beta
4701 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4702 omega = alpha/sum(alpha)
4703
4704
4705# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4706#if defined(MFC_OpenACC)
4707# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4708!$acc loop seq
4709# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4710#elif defined(MFC_OpenMP)
4711# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4712
4713# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4714#endif
4715 do q = 0, weno_num_stencils
4716 if (omega(q) < teno_ct) then ! Equation 26
4717 delta(q) = 0._wp
4718 else
4719 delta(q) = 1._wp
4720 end if
4721 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4722 end do
4723# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4724 end if
4725
4726 omega = alpha/sum(alpha)
4727
4728 vl_rs_vf_x(j, k, l, &
4729 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4730
4731 if (teno) then
4732# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4733 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4734# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4735 end if
4736
4737 if (.not. teno) then
4738 poly(3) = vp0 + poly_coef_cbr_x(j, 0, &
4739 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, &
4740 & 1)*dvd(1) + poly_coef_cbr_x(j, 0, 2)*dvd(0)
4741 poly(2) = vp0 + poly_coef_cbr_x(j, 1, &
4742 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, &
4743 & 1)*dvd(0) + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
4744 poly(1) = vp0 + poly_coef_cbr_x(j, 2, &
4745 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4746 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4747 poly(0) = vp0 + poly_coef_cbr_x(j, 3, &
4748 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4749 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4750 else
4751# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4752 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4753 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4754 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4755 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4756 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4757# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4758 end if
4759
4760 if (wenojs) then
4761 do q = 0, weno_num_stencils
4762 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4763 end do
4764 else if (mapped_weno) then
4765 do q = 0, weno_num_stencils
4766 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4767 end do
4768 omega = alpha/sum(alpha)
4769 do q = 0, weno_num_stencils
4770 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
4771 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
4772 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
4773 end do
4774 else if (wenoz) then
4775
4776# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4777#if defined(MFC_OpenACC)
4778# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4779!$acc loop seq
4780# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4781#elif defined(MFC_OpenMP)
4782# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4783
4784# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4785#endif
4786 do q = 0, weno_num_stencils
4787 ! wenoz_q = 2,3,4 for stability
4788 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4789 end do
4790 else if (teno) then
4791
4792# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4793#if defined(MFC_OpenACC)
4794# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4795!$acc loop seq
4796# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4797#elif defined(MFC_OpenMP)
4798# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4799
4800# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4801#endif
4802 do q = 0, weno_num_stencils
4803 alpha(q) = delta(q)*d_cbr_x(q, j)
4804 end do
4805 end if
4806
4807 omega = alpha/sum(alpha)
4808
4809 vr_rs_vf_x(j, k, l, &
4810 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4811
4812 if (teno) then
4813# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4814 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4815# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4816 end if
4817 end do
4818 end do
4819 end do
4820 end do
4821
4822# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4823#if defined(MFC_OpenACC)
4824# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4825!$acc end parallel loop
4826# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4827#elif defined(MFC_OpenMP)
4828# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4829
4830# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4831!$omp end target teams loop
4832# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4833#endif
4834 end if
4835# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4836# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4837# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4838 if (weno_dir == 2) then
4839
4840# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4841
4842# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4843#if defined(MFC_OpenACC)
4844# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4845!$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)
4846# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4847#elif defined(MFC_OpenMP)
4848# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4849
4850# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4851
4852# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4853
4854# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4855!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4856# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4857!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4858# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4859#endif
4860# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4861 do l = is3_weno%beg, is3_weno%end
4862 do k = is1_weno%beg, is1_weno%end
4863 do j = is2_weno%beg, is2_weno%end
4864
4865# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4866#if defined(MFC_OpenACC)
4867# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4868!$acc loop seq
4869# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4870#elif defined(MFC_OpenMP)
4871# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4872
4873# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4874#endif
4875 do i = 1, v_size
4876 alpha(:) = 0._wp
4877
4878 vp0 = v_rs_weno(j, k, l, i)
4879 vm1 = v_rs_weno(j, k - 1, l, i)
4880 vm2 = v_rs_weno(j, k - 2, l, i)
4881 vm3 = v_rs_weno(j, k - 3, l, i)
4882 vp1 = v_rs_weno(j, k + 1, l, i)
4883 vp2 = v_rs_weno(j, k + 2, l, i)
4884 vp3 = v_rs_weno(j, k + 3, l, i)
4885
4886 if (teno) then
4887 v(-3) = vm3
4888 v(-2) = vm2
4889 v(-1) = vm1
4890 v(0) = vp0
4891 v(1) = vp1
4892 v(2) = vp2
4893 v(3) = vp3
4894 end if
4895
4896 if (.not. teno) then
4897 dvd(2) = vp3 - vp2
4898 dvd(1) = vp2 - vp1
4899 dvd(0) = vp1 - vp0
4900 dvd(-1) = vp0 - vm1
4901 dvd(-2) = vm1 - vm2
4902 dvd(-3) = vm2 - vm3
4903
4904 poly(3) = vp0 + poly_coef_cbl_y(k, 0, &
4905 & 0)*dvd(2) + poly_coef_cbl_y(k, 0, &
4906 & 1)*dvd(1) + poly_coef_cbl_y(k, 0, 2)*dvd(0)
4907 poly(2) = vp0 + poly_coef_cbl_y(k, 1, &
4908 & 0)*dvd(1) + poly_coef_cbl_y(k, 1, &
4909 & 1)*dvd(0) + poly_coef_cbl_y(k, 1, 2)*dvd(-1)
4910 poly(1) = vp0 + poly_coef_cbl_y(k, 2, &
4911 & 0)*dvd(0) + poly_coef_cbl_y(k, 2, &
4912 & 1)*dvd(-1) + poly_coef_cbl_y(k, 2, 2)*dvd(-2)
4913 poly(0) = vp0 + poly_coef_cbl_y(k, 3, &
4914 & 0)*dvd(-1) + poly_coef_cbl_y(k, 3, &
4915 & 1)*dvd(-2) + poly_coef_cbl_y(k, 3, 2)*dvd(-3)
4916 else
4917# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4918 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4919 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4920 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4921 ! to keep the stencil order to reuse the beta coefficients
4922 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4923 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4924 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4925 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4926 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4927# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4928 end if
4929
4930 if (.not. teno) then
4931 beta(3) = beta_coef_y(k, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(k, &
4932 & 0, 1)*dvd(2)*dvd(1) + beta_coef_y(k, 0, &
4933 & 2)*dvd(2)*dvd(0) + beta_coef_y(k, 0, &
4934 & 3)*dvd(1)*dvd(1) + beta_coef_y(k, 0, &
4935 & 4)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 5)*dvd(0)*dvd(0) + weno_eps
4936
4937 beta(2) = beta_coef_y(k, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4938 & 1, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 1, &
4939 & 2)*dvd(1)*dvd(-1) + beta_coef_y(k, 1, &
4940 & 3)*dvd(0)*dvd(0) + beta_coef_y(k, 1, &
4941 & 4)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4942
4943 beta(1) = beta_coef_y(k, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4944 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 2, &
4945 & 2)*dvd(0)*dvd(-2) + beta_coef_y(k, 2, &
4946 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4947 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4948
4949 beta(0) = beta_coef_y(k, 3, &
4950 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 3, &
4951 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 3, &
4952 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(k, 3, &
4953 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(k, 3, &
4954 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(k, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4955 else
4956# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4957 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4958 ! & Tang, 2019) Section 3.2
4959 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4960 & **2._wp)/4._wp + weno_eps
4961 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4962 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4963 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4964 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4965
4966 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4967 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4968 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4969
4970 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4971 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4972 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4973# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4974 end if
4975
4976 if (wenojs) then
4977 do q = 0, weno_num_stencils
4978 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4979 end do
4980 else if (mapped_weno) then
4981 do q = 0, weno_num_stencils
4982 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4983 end do
4984 omega = alpha/sum(alpha)
4985 do q = 0, weno_num_stencils
4986 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4987 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4988 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4989 end do
4990 else if (wenoz) then
4991 ! Castro, et al. (2010) Don & Borges (2013) also helps
4992 tau = abs(beta(3) - beta(0)) ! Equation 50
4993
4994# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4995#if defined(MFC_OpenACC)
4996# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4997!$acc loop seq
4998# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4999#elif defined(MFC_OpenMP)
5000# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5001
5002# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5003#endif
5004 do q = 0, weno_num_stencils
5005 ! wenoz_q = 2,3,4 for stability
5006 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
5007 end do
5008 else if (teno) then
5009# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5010 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5011 alpha = 1._wp + tau/beta
5012 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5013 omega = alpha/sum(alpha)
5014
5015
5016# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5017#if defined(MFC_OpenACC)
5018# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5019!$acc loop seq
5020# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5021#elif defined(MFC_OpenMP)
5022# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5023
5024# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5025#endif
5026 do q = 0, weno_num_stencils
5027 if (omega(q) < teno_ct) then ! Equation 26
5028 delta(q) = 0._wp
5029 else
5030 delta(q) = 1._wp
5031 end if
5032 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
5033 end do
5034# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5035 end if
5036
5037 omega = alpha/sum(alpha)
5038
5039 vl_rs_vf_x(j, k, l, &
5040 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5041
5042 if (teno) then
5043# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5044 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5045# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5046 end if
5047
5048 if (.not. teno) then
5049 poly(3) = vp0 + poly_coef_cbr_y(k, 0, &
5050 & 0)*dvd(2) + poly_coef_cbr_y(k, 0, &
5051 & 1)*dvd(1) + poly_coef_cbr_y(k, 0, 2)*dvd(0)
5052 poly(2) = vp0 + poly_coef_cbr_y(k, 1, &
5053 & 0)*dvd(1) + poly_coef_cbr_y(k, 1, &
5054 & 1)*dvd(0) + poly_coef_cbr_y(k, 1, 2)*dvd(-1)
5055 poly(1) = vp0 + poly_coef_cbr_y(k, 2, &
5056 & 0)*dvd(0) + poly_coef_cbr_y(k, 2, &
5057 & 1)*dvd(-1) + poly_coef_cbr_y(k, 2, 2)*dvd(-2)
5058 poly(0) = vp0 + poly_coef_cbr_y(k, 3, &
5059 & 0)*dvd(-1) + poly_coef_cbr_y(k, 3, &
5060 & 1)*dvd(-2) + poly_coef_cbr_y(k, 3, 2)*dvd(-3)
5061 else
5062# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5063 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5064 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5065 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5066 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5067 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5068# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5069 end if
5070
5071 if (wenojs) then
5072 do q = 0, weno_num_stencils
5073 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
5074 end do
5075 else if (mapped_weno) then
5076 do q = 0, weno_num_stencils
5077 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
5078 end do
5079 omega = alpha/sum(alpha)
5080 do q = 0, weno_num_stencils
5081 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
5082 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
5083 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
5084 end do
5085 else if (wenoz) then
5086
5087# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5088#if defined(MFC_OpenACC)
5089# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5090!$acc loop seq
5091# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5092#elif defined(MFC_OpenMP)
5093# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5094
5095# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5096#endif
5097 do q = 0, weno_num_stencils
5098 ! wenoz_q = 2,3,4 for stability
5099 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
5100 end do
5101 else if (teno) then
5102
5103# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5104#if defined(MFC_OpenACC)
5105# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5106!$acc loop seq
5107# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5108#elif defined(MFC_OpenMP)
5109# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5110
5111# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5112#endif
5113 do q = 0, weno_num_stencils
5114 alpha(q) = delta(q)*d_cbr_y(q, k)
5115 end do
5116 end if
5117
5118 omega = alpha/sum(alpha)
5119
5120 vr_rs_vf_x(j, k, l, &
5121 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5122
5123 if (teno) then
5124# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5125 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5126# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5127 end if
5128 end do
5129 end do
5130 end do
5131 end do
5132
5133# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5134#if defined(MFC_OpenACC)
5135# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5136!$acc end parallel loop
5137# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5138#elif defined(MFC_OpenMP)
5139# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5140
5141# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5142!$omp end target teams loop
5143# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5144#endif
5145 end if
5146# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5147# 1253 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5148# 1254 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5149 if (weno_dir == 3) then
5150
5151# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5152
5153# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5154#if defined(MFC_OpenACC)
5155# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5156!$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)
5157# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5158#elif defined(MFC_OpenMP)
5159# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5160
5161# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5162
5163# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5164
5165# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5166!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5167# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5168!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5169# 1255 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5170#endif
5171# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5172 do l = is1_weno%beg, is1_weno%end
5173 do k = is2_weno%beg, is2_weno%end
5174 do j = is3_weno%beg, is3_weno%end
5175
5176# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5177#if defined(MFC_OpenACC)
5178# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5179!$acc loop seq
5180# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5181#elif defined(MFC_OpenMP)
5182# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5183
5184# 1260 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5185#endif
5186 do i = 1, v_size
5187 alpha(:) = 0._wp
5188
5189 vp0 = v_rs_weno(j, k, l, i)
5190 vm1 = v_rs_weno(j, k, l - 1, i)
5191 vm2 = v_rs_weno(j, k, l - 2, i)
5192 vm3 = v_rs_weno(j, k, l - 3, i)
5193 vp1 = v_rs_weno(j, k, l + 1, i)
5194 vp2 = v_rs_weno(j, k, l + 2, i)
5195 vp3 = v_rs_weno(j, k, l + 3, i)
5196
5197 if (teno) then
5198 v(-3) = vm3
5199 v(-2) = vm2
5200 v(-1) = vm1
5201 v(0) = vp0
5202 v(1) = vp1
5203 v(2) = vp2
5204 v(3) = vp3
5205 end if
5206
5207 if (.not. teno) then
5208 dvd(2) = vp3 - vp2
5209 dvd(1) = vp2 - vp1
5210 dvd(0) = vp1 - vp0
5211 dvd(-1) = vp0 - vm1
5212 dvd(-2) = vm1 - vm2
5213 dvd(-3) = vm2 - vm3
5214
5215 poly(3) = vp0 + poly_coef_cbl_z(l, 0, &
5216 & 0)*dvd(2) + poly_coef_cbl_z(l, 0, &
5217 & 1)*dvd(1) + poly_coef_cbl_z(l, 0, 2)*dvd(0)
5218 poly(2) = vp0 + poly_coef_cbl_z(l, 1, &
5219 & 0)*dvd(1) + poly_coef_cbl_z(l, 1, &
5220 & 1)*dvd(0) + poly_coef_cbl_z(l, 1, 2)*dvd(-1)
5221 poly(1) = vp0 + poly_coef_cbl_z(l, 2, &
5222 & 0)*dvd(0) + poly_coef_cbl_z(l, 2, &
5223 & 1)*dvd(-1) + poly_coef_cbl_z(l, 2, 2)*dvd(-2)
5224 poly(0) = vp0 + poly_coef_cbl_z(l, 3, &
5225 & 0)*dvd(-1) + poly_coef_cbl_z(l, 3, &
5226 & 1)*dvd(-2) + poly_coef_cbl_z(l, 3, 2)*dvd(-3)
5227 else
5228# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5229 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
5230 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
5231 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
5232 ! to keep the stencil order to reuse the beta coefficients
5233 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
5234 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
5235 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
5236 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
5237 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
5238# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5239 end if
5240
5241 if (.not. teno) then
5242 beta(3) = beta_coef_z(l, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(l, &
5243 & 0, 1)*dvd(2)*dvd(1) + beta_coef_z(l, 0, &
5244 & 2)*dvd(2)*dvd(0) + beta_coef_z(l, 0, &
5245 & 3)*dvd(1)*dvd(1) + beta_coef_z(l, 0, &
5246 & 4)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 5)*dvd(0)*dvd(0) + weno_eps
5247
5248 beta(2) = beta_coef_z(l, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
5249 & 1, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 1, &
5250 & 2)*dvd(1)*dvd(-1) + beta_coef_z(l, 1, &
5251 & 3)*dvd(0)*dvd(0) + beta_coef_z(l, 1, &
5252 & 4)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
5253
5254 beta(1) = beta_coef_z(l, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
5255 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 2, &
5256 & 2)*dvd(0)*dvd(-2) + beta_coef_z(l, 2, &
5257 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
5258 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
5259
5260 beta(0) = beta_coef_z(l, 3, &
5261 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 3, &
5262 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 3, &
5263 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(l, 3, &
5264 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(l, 3, &
5265 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(l, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5266 else
5267# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5268 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5269 ! & Tang, 2019) Section 3.2
5270 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5271 & **2._wp)/4._wp + weno_eps
5272 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5273 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5274 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5275 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5276
5277 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5278 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5279 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5280
5281 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5282 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5283 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5284# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5285 end if
5286
5287 if (wenojs) then
5288 do q = 0, weno_num_stencils
5289 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5290 end do
5291 else if (mapped_weno) then
5292 do q = 0, weno_num_stencils
5293 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5294 end do
5295 omega = alpha/sum(alpha)
5296 do q = 0, weno_num_stencils
5297 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
5298 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
5299 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
5300 end do
5301 else if (wenoz) then
5302 ! Castro, et al. (2010) Don & Borges (2013) also helps
5303 tau = abs(beta(3) - beta(0)) ! Equation 50
5304
5305# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5306#if defined(MFC_OpenACC)
5307# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5308!$acc loop seq
5309# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5310#elif defined(MFC_OpenMP)
5311# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5312
5313# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5314#endif
5315 do q = 0, weno_num_stencils
5316 ! wenoz_q = 2,3,4 for stability
5317 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5318 end do
5319 else if (teno) then
5320# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5321 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5322 alpha = 1._wp + tau/beta
5323 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5324 omega = alpha/sum(alpha)
5325
5326
5327# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5328#if defined(MFC_OpenACC)
5329# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5330!$acc loop seq
5331# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5332#elif defined(MFC_OpenMP)
5333# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5334
5335# 1391 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5336#endif
5337 do q = 0, weno_num_stencils
5338 if (omega(q) < teno_ct) then ! Equation 26
5339 delta(q) = 0._wp
5340 else
5341 delta(q) = 1._wp
5342 end if
5343 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
5344 end do
5345# 1401 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5346 end if
5347
5348 omega = alpha/sum(alpha)
5349
5350 vl_rs_vf_x(j, k, l, &
5351 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5352
5353 if (teno) then
5354# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5355 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5356# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5357 end if
5358
5359 if (.not. teno) then
5360 poly(3) = vp0 + poly_coef_cbr_z(l, 0, &
5361 & 0)*dvd(2) + poly_coef_cbr_z(l, 0, &
5362 & 1)*dvd(1) + poly_coef_cbr_z(l, 0, 2)*dvd(0)
5363 poly(2) = vp0 + poly_coef_cbr_z(l, 1, &
5364 & 0)*dvd(1) + poly_coef_cbr_z(l, 1, &
5365 & 1)*dvd(0) + poly_coef_cbr_z(l, 1, 2)*dvd(-1)
5366 poly(1) = vp0 + poly_coef_cbr_z(l, 2, &
5367 & 0)*dvd(0) + poly_coef_cbr_z(l, 2, &
5368 & 1)*dvd(-1) + poly_coef_cbr_z(l, 2, 2)*dvd(-2)
5369 poly(0) = vp0 + poly_coef_cbr_z(l, 3, &
5370 & 0)*dvd(-1) + poly_coef_cbr_z(l, 3, &
5371 & 1)*dvd(-2) + poly_coef_cbr_z(l, 3, 2)*dvd(-3)
5372 else
5373# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5374 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5375 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5376 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5377 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5378 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5379# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5380 end if
5381
5382 if (wenojs) then
5383 do q = 0, weno_num_stencils
5384 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5385 end do
5386 else if (mapped_weno) then
5387 do q = 0, weno_num_stencils
5388 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5389 end do
5390 omega = alpha/sum(alpha)
5391 do q = 0, weno_num_stencils
5392 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
5393 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
5394 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
5395 end do
5396 else if (wenoz) then
5397
5398# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5399#if defined(MFC_OpenACC)
5400# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5401!$acc loop seq
5402# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5403#elif defined(MFC_OpenMP)
5404# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5405
5406# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5407#endif
5408 do q = 0, weno_num_stencils
5409 ! wenoz_q = 2,3,4 for stability
5410 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5411 end do
5412 else if (teno) then
5413
5414# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5415#if defined(MFC_OpenACC)
5416# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5417!$acc loop seq
5418# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5419#elif defined(MFC_OpenMP)
5420# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5421
5422# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5423#endif
5424 do q = 0, weno_num_stencils
5425 alpha(q) = delta(q)*d_cbr_z(q, l)
5426 end do
5427 end if
5428
5429 omega = alpha/sum(alpha)
5430
5431 vr_rs_vf_x(j, k, l, &
5432 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5433
5434 if (teno) then
5435# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5436 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5437# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5438 end if
5439 end do
5440 end do
5441 end do
5442 end do
5443
5444# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5445#if defined(MFC_OpenACC)
5446# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5447!$acc end parallel loop
5448# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5449#elif defined(MFC_OpenMP)
5450# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5451
5452# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5453!$omp end target teams loop
5454# 1478 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5455#endif
5456 end if
5457# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5458# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5459 end if
5460
5461 if (int_comp > 0 .and. v_size >= eqn_idx%adv%end) then
5462 call nvtxstartrange("WENO-INTCOMP")
5463 call s_thinc_compression(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno, is2_weno, is3_weno)
5464 call nvtxendrange()
5465 end if
5466
5467 end subroutine s_weno
5468
5469 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5470 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf, weno_dir)
5471
5472 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5473 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5474 integer, intent(in) :: weno_dir
5475 integer :: i, j, k, l
5476 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5477 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5478 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5479 ! the cell- average variables.
5480 real(wp) :: vL_UL, vR_UL
5481 real(wp) :: vL_MD, vR_MD
5482 real(wp) :: vL_LC, vR_LC
5483 real(wp) :: vL_min, vR_min
5484 real(wp) :: vL_max, vR_max
5485 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5486 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5487 real(wp), parameter :: alpha_mp = 2._wp
5488 real(wp), parameter :: beta_mp = 4._wp/3._wp
5489 real(wp) :: vp0, vp1, vp2, vm1, vm2
5490
5491# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5492# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5493# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5494 if (weno_dir == 1) then
5495
5496# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5497
5498# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5499#if defined(MFC_OpenACC)
5500# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5501!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5502# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5503#elif defined(MFC_OpenMP)
5504# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5505
5506# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5507
5508# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5509
5510# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5511!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5512# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5513!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5514# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5515#endif
5516 do l = is3_weno%beg, is3_weno%end
5517 do k = is2_weno%beg, is2_weno%end
5518 do j = is1_weno%beg, is1_weno%end
5519 do i = 1, v_size
5520 ! Second-order undivided differences for curvature estimation
5521
5522 vp0 = v_rs_ws(j, k, l, i)
5523 vm1 = v_rs_ws(j - 1, k, l, i)
5524 vm2 = v_rs_ws(j - 2, k, l, i)
5525 vp1 = v_rs_ws(j + 1, k, l, i)
5526 vp2 = v_rs_ws(j + 2, k, l, i)
5527
5528 d(-1) = vp0 + vm2 - vm1*2._wp
5529 d(0) = vp1 + vm1 - vp0*2._wp
5530 d(1) = vp2 + vp0 - vp1*2._wp
5531
5532 ! Median function for oscillation detection
5533 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5534 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5535 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5536 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5537
5538 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5539 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5540 & 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
5541
5542 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5543
5544 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5545
5546 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5547
5548 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5549
5550 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5551
5552 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, &
5553 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5554 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5555 ! END: Left Monotonicity Preserving Bound
5556
5557 ! Right Monotonicity Preserving Bound
5558 d(-1) = vp0 + vm2 - vm1*2._wp
5559 d(0) = vp1 + vm1 - vp0*2._wp
5560 d(1) = vp2 + vp0 - vp1*2._wp
5561
5562 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5563 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5564 & 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
5565
5566 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5567 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5568 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5569 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5570
5571 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5572
5573 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5574
5575 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5576
5577 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5578
5579 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5580
5581 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, &
5582 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5583 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5584 ! END: Right Monotonicity Preserving Bound
5585 end do
5586 end do
5587 end do
5588 end do
5589
5590# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5591#if defined(MFC_OpenACC)
5592# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5593!$acc end parallel loop
5594# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5595#elif defined(MFC_OpenMP)
5596# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5597
5598# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5599!$omp end target teams loop
5600# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5601#endif
5602 end if
5603# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5604# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5605# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5606 if (weno_dir == 2) then
5607
5608# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5609
5610# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5611#if defined(MFC_OpenACC)
5612# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5613!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5614# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5615#elif defined(MFC_OpenMP)
5616# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5617
5618# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5619
5620# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5621
5622# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5623!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5624# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5625!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5626# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5627#endif
5628 do l = is3_weno%beg, is3_weno%end
5629 do k = is1_weno%beg, is1_weno%end
5630 do j = is2_weno%beg, is2_weno%end
5631 do i = 1, v_size
5632 ! Second-order undivided differences for curvature estimation
5633
5634 vp0 = v_rs_ws(j, k, l, i)
5635 vm1 = v_rs_ws(j, k - 1, l, i)
5636 vm2 = v_rs_ws(j, k - 2, l, i)
5637 vp1 = v_rs_ws(j, k + 1, l, i)
5638 vp2 = v_rs_ws(j, k + 2, l, i)
5639
5640 d(-1) = vp0 + vm2 - vm1*2._wp
5641 d(0) = vp1 + vm1 - vp0*2._wp
5642 d(1) = vp2 + vp0 - vp1*2._wp
5643
5644 ! Median function for oscillation detection
5645 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5646 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5647 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5648 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5649
5650 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5651 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5652 & 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
5653
5654 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5655
5656 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5657
5658 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5659
5660 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5661
5662 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5663
5664 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, &
5665 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5666 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5667 ! END: Left Monotonicity Preserving Bound
5668
5669 ! Right Monotonicity Preserving Bound
5670 d(-1) = vp0 + vm2 - vm1*2._wp
5671 d(0) = vp1 + vm1 - vp0*2._wp
5672 d(1) = vp2 + vp0 - vp1*2._wp
5673
5674 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5675 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5676 & 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
5677
5678 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5679 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5680 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5681 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5682
5683 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5684
5685 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5686
5687 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5688
5689 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5690
5691 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5692
5693 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, &
5694 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5695 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5696 ! END: Right Monotonicity Preserving Bound
5697 end do
5698 end do
5699 end do
5700 end do
5701
5702# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5703#if defined(MFC_OpenACC)
5704# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5705!$acc end parallel loop
5706# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5707#elif defined(MFC_OpenMP)
5708# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5709
5710# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5711!$omp end target teams loop
5712# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5713#endif
5714 end if
5715# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5716# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5717# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5718 if (weno_dir == 3) then
5719
5720# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5721
5722# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5723#if defined(MFC_OpenACC)
5724# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5725!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5726# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5727#elif defined(MFC_OpenMP)
5728# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5729
5730# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5731
5732# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5733
5734# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5735!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5736# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5737!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5738# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5739#endif
5740 do l = is1_weno%beg, is1_weno%end
5741 do k = is2_weno%beg, is2_weno%end
5742 do j = is3_weno%beg, is3_weno%end
5743 do i = 1, v_size
5744 ! Second-order undivided differences for curvature estimation
5745
5746 vp0 = v_rs_ws(j, k, l, i)
5747 vm1 = v_rs_ws(j, k, l - 1, i)
5748 vm2 = v_rs_ws(j, k, l - 2, i)
5749 vp1 = v_rs_ws(j, k, l + 1, i)
5750 vp2 = v_rs_ws(j, k, l + 2, i)
5751
5752 d(-1) = vp0 + vm2 - vm1*2._wp
5753 d(0) = vp1 + vm1 - vp0*2._wp
5754 d(1) = vp2 + vp0 - vp1*2._wp
5755
5756 ! Median function for oscillation detection
5757 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5758 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5759 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5760 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5761
5762 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5763 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5764 & 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
5765
5766 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5767
5768 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5769
5770 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5771
5772 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5773
5774 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5775
5776 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, &
5777 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5778 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5779 ! END: Left Monotonicity Preserving Bound
5780
5781 ! Right Monotonicity Preserving Bound
5782 d(-1) = vp0 + vm2 - vm1*2._wp
5783 d(0) = vp1 + vm1 - vp0*2._wp
5784 d(1) = vp2 + vp0 - vp1*2._wp
5785
5786 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5787 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5788 & 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
5789
5790 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5791 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5792 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5793 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5794
5795 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5796
5797 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5798
5799 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5800
5801 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5802
5803 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5804
5805 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, &
5806 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5807 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5808 ! END: Right Monotonicity Preserving Bound
5809 end do
5810 end do
5811 end do
5812 end do
5813
5814# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5815#if defined(MFC_OpenACC)
5816# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5817!$acc end parallel loop
5818# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5819#elif defined(MFC_OpenMP)
5820# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5821
5822# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5823!$omp end target teams loop
5824# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5825#endif
5826 end if
5827# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5828
5829 end subroutine s_preserve_monotonicity
5830
5831 !> Module deallocation and/or disassociation procedures
5832 impure subroutine s_finalize_weno_module()
5833
5834 if (weno_order == 1) return
5835
5836 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5837
5838#ifdef MFC_DEBUG
5839# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5840 block
5841# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5842 use iso_fortran_env, only: output_unit
5843# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844
5845# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5846 print *, 'm_weno.fpp:1608: ', '@:DEALLOCATE(v_rs_weno)'
5847# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5848
5849# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5850 call flush (output_unit)
5851# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5852 end block
5853# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5854#endif
5855# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5856
5857# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5858#if defined(MFC_OpenACC)
5859# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5860!$acc exit data delete(v_rs_weno)
5861# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5862#elif defined(MFC_OpenMP)
5863# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5864!$omp target exit data map(release:v_rs_weno)
5865# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5866#endif
5867# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5868 deallocate (v_rs_weno)
5869
5870 ! Deallocating WENO coefficients in x-direction
5871#ifdef MFC_DEBUG
5872# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5873 block
5874# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5875 use iso_fortran_env, only: output_unit
5876# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5877
5878# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879 print *, 'm_weno.fpp:1611: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5880# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5881
5882# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5883 call flush (output_unit)
5884# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5885 end block
5886# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5887#endif
5888# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5889
5890# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5891#if defined(MFC_OpenACC)
5892# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5893!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5894# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5895#elif defined(MFC_OpenMP)
5896# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5897!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5898# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5899#endif
5900# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5901 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5902#ifdef MFC_DEBUG
5903# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5904 block
5905# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5906 use iso_fortran_env, only: output_unit
5907# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5908
5909# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5910 print *, 'm_weno.fpp:1612: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5911# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5912
5913# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5914 call flush (output_unit)
5915# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5916 end block
5917# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5918#endif
5919# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5920
5921# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5922#if defined(MFC_OpenACC)
5923# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5924!$acc exit data delete(d_cbL_x, d_cbR_x)
5925# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5926#elif defined(MFC_OpenMP)
5927# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5928!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5929# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5930#endif
5931# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5932 deallocate (d_cbl_x, d_cbr_x)
5933#ifdef MFC_DEBUG
5934# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5935 block
5936# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5937 use iso_fortran_env, only: output_unit
5938# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5939
5940# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5941 print *, 'm_weno.fpp:1613: ', '@:DEALLOCATE(beta_coef_x)'
5942# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5943
5944# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5945 call flush (output_unit)
5946# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5947 end block
5948# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5949#endif
5950# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5951
5952# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5953#if defined(MFC_OpenACC)
5954# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5955!$acc exit data delete(beta_coef_x)
5956# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5957#elif defined(MFC_OpenMP)
5958# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5959!$omp target exit data map(release:beta_coef_x)
5960# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5961#endif
5962# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5963 deallocate (beta_coef_x)
5964
5965 ! Deallocating WENO coefficients in y-direction
5966 if (n == 0) return
5967
5968#ifdef MFC_DEBUG
5969# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5970 block
5971# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5972 use iso_fortran_env, only: output_unit
5973# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5974
5975# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5976 print *, 'm_weno.fpp:1618: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5977# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5978
5979# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5980 call flush (output_unit)
5981# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5982 end block
5983# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5984#endif
5985# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5986
5987# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5988#if defined(MFC_OpenACC)
5989# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5990!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5991# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5992#elif defined(MFC_OpenMP)
5993# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5994!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5995# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5996#endif
5997# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5998 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5999#ifdef MFC_DEBUG
6000# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6001 block
6002# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6003 use iso_fortran_env, only: output_unit
6004# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6005
6006# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6007 print *, 'm_weno.fpp:1619: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
6008# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6009
6010# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6011 call flush (output_unit)
6012# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6013 end block
6014# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6015#endif
6016# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6017
6018# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6019#if defined(MFC_OpenACC)
6020# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6021!$acc exit data delete(d_cbL_y, d_cbR_y)
6022# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6023#elif defined(MFC_OpenMP)
6024# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6025!$omp target exit data map(release:d_cbL_y, d_cbR_y)
6026# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6027#endif
6028# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6029 deallocate (d_cbl_y, d_cbr_y)
6030#ifdef MFC_DEBUG
6031# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6032 block
6033# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6034 use iso_fortran_env, only: output_unit
6035# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6036
6037# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6038 print *, 'm_weno.fpp:1620: ', '@:DEALLOCATE(beta_coef_y)'
6039# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6040
6041# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6042 call flush (output_unit)
6043# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6044 end block
6045# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6046#endif
6047# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6048
6049# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6050#if defined(MFC_OpenACC)
6051# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6052!$acc exit data delete(beta_coef_y)
6053# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6054#elif defined(MFC_OpenMP)
6055# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6056!$omp target exit data map(release:beta_coef_y)
6057# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6058#endif
6059# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6060 deallocate (beta_coef_y)
6061
6062 ! Deallocating WENO coefficients in z-direction
6063 if (p == 0) return
6064
6065#ifdef MFC_DEBUG
6066# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6067 block
6068# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6069 use iso_fortran_env, only: output_unit
6070# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6071
6072# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6073 print *, 'm_weno.fpp:1625: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
6074# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6075
6076# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6077 call flush (output_unit)
6078# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6079 end block
6080# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6081#endif
6082# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6083
6084# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6085#if defined(MFC_OpenACC)
6086# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6087!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
6088# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6089#elif defined(MFC_OpenMP)
6090# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6091!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
6092# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6093#endif
6094# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6095 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
6096#ifdef MFC_DEBUG
6097# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6098 block
6099# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6100 use iso_fortran_env, only: output_unit
6101# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6102
6103# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6104 print *, 'm_weno.fpp:1626: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
6105# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6106
6107# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6108 call flush (output_unit)
6109# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6110 end block
6111# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6112#endif
6113# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6114
6115# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6116#if defined(MFC_OpenACC)
6117# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6118!$acc exit data delete(d_cbL_z, d_cbR_z)
6119# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6120#elif defined(MFC_OpenMP)
6121# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6122!$omp target exit data map(release:d_cbL_z, d_cbR_z)
6123# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6124#endif
6125# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6126 deallocate (d_cbl_z, d_cbr_z)
6127#ifdef MFC_DEBUG
6128# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6129 block
6130# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6131 use iso_fortran_env, only: output_unit
6132# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6133
6134# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6135 print *, 'm_weno.fpp:1627: ', '@:DEALLOCATE(beta_coef_z)'
6136# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6137
6138# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6139 call flush (output_unit)
6140# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6141 end block
6142# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6143#endif
6144# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6145
6146# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6147#if defined(MFC_OpenACC)
6148# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6149!$acc exit data delete(beta_coef_z)
6150# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6151#elif defined(MFC_OpenMP)
6152# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6153!$omp target exit data map(release:beta_coef_z)
6154# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6155#endif
6156# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6157 deallocate (beta_coef_z)
6158
6159 end subroutine s_finalize_weno_module
6160
6161end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1007
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1007
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1007
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:335
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:346
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:805
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:346
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:341
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:853
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:346
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:345
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:5471
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:482
m_weno::d_cbl_z
real(wp), dimension(:,:), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:415
m_weno::poly_coef_cbl_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:379
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Definition m_weno.fpp.f90:503
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:482
m_weno::d_cbl_y
real(wp), dimension(:,:), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:414
m_weno::beta_coef_y
real(wp), dimension(:,:,:), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:437
m_weno::s_pack_weno_input_arr
subroutine, public s_pack_weno_input_arr(v_vf)
Definition m_weno.fpp.f90:3201
m_weno::d_cbr_y
real(wp), dimension(:,:), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:417
m_weno::beta_coef_x
real(wp), dimension(:,:,:), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:436
m_weno::beta_coef_z
real(wp), dimension(:,:,:), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:438
m_weno::d_cbr_x
real(wp), dimension(:,:), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:416
m_weno::d_cbr_z
real(wp), dimension(:,:), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:418
m_weno::uniform_grid
logical, dimension(3) uniform_grid
True if grid spacing is uniform in each direction.
Definition m_weno.fpp.f90:467
m_weno::poly_coef_cbl_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:381
m_weno::poly_coef_cbr_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:382
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:454
m_weno::d_cbl_x
real(wp), dimension(:,:), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:413
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:482
m_weno::poly_coef_cbr_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:383
m_weno::v_rs_weno
real(wp), dimension(:,:,:,:), allocatable v_rs_weno
Definition m_weno.fpp.f90:358
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:3251
m_weno::poly_coef_cbl_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:380
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:1098
m_weno::poly_coef_cbr_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:384
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5833
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:429