MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_weno.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2!>
3!! @file
4!! @brief Contains module m_weno
5# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
6! This file exists so that Fypp can be run without generating case.fpp files for
7! each target. This is useful when generating documentation, for example. This
8! should also let MFC be built with CMake directly, without invoking mfc.sh.
9
10! For pre-process.
11# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
12
13! For moving immersed boundaries in simulation
14# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
15# 5 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
16# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
17# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
18# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
19# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
21# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32
33# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34
35# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
36
37# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38
39# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40
41# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42
43# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44! New line at end of file is required for FYPP
45# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
46# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
47# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
48# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73! New line at end of file is required for FYPP
74# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
75
76# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152! New line at end of file is required for FYPP
153# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
154# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
155# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
156# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175
176# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179
180# 145 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
181! New line at end of file is required for FYPP
182# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
183
184# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233
234# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
235
236# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
237
238# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239! New line at end of file is required for FYPP
240# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
241
242! GPU parallel region (scalar reductions, maxval/minval)
243# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245! GPU parallel loop over threads (most common GPU macro)
246# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248! Required closing for GPU_PARALLEL_LOOP
249# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251! Mark routine for device compilation
252# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254! Declare device-resident data
255# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! Inner loop within a GPU parallel region
258# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Scoped GPU data region
261# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Host code with device pointers (for MPI with GPU buffers)
264# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Allocate device memory (unscoped)
267# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! Free device memory
270# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! Atomic operation on device
273# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! End atomic capture block
276# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Copy data between host and device
279# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Synchronization barrier
282# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Import GPU library module (openacc or omp_lib)
285# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! Emit code only for AMD compiler
288# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Emit code for non-Cray compilers
291# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293! Emit code only for Cray compiler
294# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295
296! Emit code for non-NVIDIA compilers
297# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298
299# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301! New line at end of file is required for FYPP
302# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
303
304# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
305
306! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
307! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
308! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
309# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Allocate and create GPU device memory
312# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Free GPU device memory and deallocate
315# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for vector fields
318# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320! Cray-specific GPU pointer setup for scalar fields
321# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323! Cray-specific GPU pointer setup for acoustic source spatials
324# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
325
326# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
327
328# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
329! New line at end of file is required for FYPP
330# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
331
332!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
333module m_weno
334
335 use m_derived_types
336 use m_global_parameters
337 use m_variables_conversion
338 ! $:USE_GPU_MODULE()
339
340 use m_mpi_proxy
341 use m_thinc, only: s_thinc_compression
342 use m_nvtx
343
344 private; public :: s_initialize_weno_module, s_finalize_weno_module, s_weno, s_pack_weno_input_arr
345
346 !> @name The cell-average variables that will be WENO-reconstructed unpacked into an array for performance
347 !> @{
348 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_weno
349 !> @}
350
351# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
352#if defined(MFC_OpenACC)
353# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
354!$acc declare create(v_rs_weno)
355# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
356#elif defined(MFC_OpenMP)
357# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
358!$omp declare target (v_rs_weno)
359# 25 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
360#endif
361
362 ! WENO Coefficients
363
364 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at the left and right quadrature points (QP), in
365 !! the x-, y- and z-directions. Note that the first dimension of the array identifies the polynomial, the second dimension
366 !! identifies the position of its coefficients and the last dimension denotes the cell-location in the relevant coordinate
367 !! direction.
368 !> @{
369 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_x
370 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_y
371 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_z
372 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_x
373 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_y
374 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_z
375 !> @}
376
377# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
378#if defined(MFC_OpenACC)
379# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
380!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
381# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
382#elif defined(MFC_OpenMP)
383# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
384!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
385# 41 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
386#endif
387
388# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
389#if defined(MFC_OpenACC)
390# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
391!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
392# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
393#elif defined(MFC_OpenMP)
394# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
395!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
396# 42 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
397#endif
398
399 !> @name The ideal weights at the left and the right cell-boundaries and at the left and the right quadrature points, in x-, y-
400 !! and z-directions. Note that the first dimension of the array identifies the weight, while the last denotes the cell-location
401 !! in the relevant coordinate direction.
402 !> @{
403 real(wp), target, allocatable, dimension(:,:) :: d_cbl_x
404 real(wp), target, allocatable, dimension(:,:) :: d_cbl_y
405 real(wp), target, allocatable, dimension(:,:) :: d_cbl_z
406 real(wp), target, allocatable, dimension(:,:) :: d_cbr_x
407 real(wp), target, allocatable, dimension(:,:) :: d_cbr_y
408 real(wp), target, allocatable, dimension(:,:) :: d_cbr_z
409 !> @}
410
411# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
412#if defined(MFC_OpenACC)
413# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
414!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
415# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
416#elif defined(MFC_OpenMP)
417# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
418!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
419# 55 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
420#endif
421
422 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note that the first array dimension identifies the
423 !! smoothness indicator, the second identifies the position of its coefficients and the last denotes the cell-location in the
424 !! relevant coordinate direction.
425 !> @{
426 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_x
427 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_y
428 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_z
429 !> @}
430
431# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
432#if defined(MFC_OpenACC)
433# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
434!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
435# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
436#elif defined(MFC_OpenMP)
437# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
438!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
439# 65 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
440#endif
441
442 ! END: WENO Coefficients
443
444 integer :: v_size !< Number of WENO-reconstructed cell-average variables
445
446# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447#if defined(MFC_OpenACC)
448# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449!$acc declare create(v_size)
450# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
451#elif defined(MFC_OpenMP)
452# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
453!$omp declare target (v_size)
454# 70 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
455#endif
456
457 logical :: uniform_grid(3) !< True if grid spacing is uniform in each direction
458
459# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
460#if defined(MFC_OpenACC)
461# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
462!$acc declare create(uniform_grid)
463# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
464#elif defined(MFC_OpenMP)
465# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
466!$omp declare target (uniform_grid)
467# 73 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
468#endif
469
470 !> @name Indical bounds in the s1-, s2- and s3-directions
471 !> @{
472 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
473#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
474
475# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
476#if defined(MFC_OpenACC)
477# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
478!$acc declare create(is1_weno, is2_weno, is3_weno)
479# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
480#elif defined(MFC_OpenMP)
481# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
482!$omp declare target (is1_weno, is2_weno, is3_weno)
483# 79 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
484#endif
485#endif
486 !
487 !> @}
488
489contains
490
491 !> Initialize the WENO module
492 impure subroutine s_initialize_weno_module
493
494 if (weno_order == 1) return
495
496 ! Allocating/Computing WENO Coefficients in x-direction
497 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
498 if (n == 0) then
499 is2_weno%beg = 0
500 else
501 is2_weno%beg = -buff_size
502 end if
503
504 is2_weno%end = n - is2_weno%beg
505
506 if (p == 0) then
507 is3_weno%beg = 0
508 else
509 is3_weno%beg = -buff_size
510 end if
511
512 is3_weno%end = p - is3_weno%beg
513
514#ifdef MFC_DEBUG
515# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
516 block
517# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
518 use iso_fortran_env, only: output_unit
519# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
520
521# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
522 print *, 'm_weno.fpp:109: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
523# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
524
525# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
526 call flush (output_unit)
527# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
528 end block
529# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
530#endif
531# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
532 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
533# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
534
535# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
536
537# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
538#if defined(MFC_OpenACC)
539# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
540!$acc enter data create(poly_coef_cbL_x)
541# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
542#elif defined(MFC_OpenMP)
543# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
544!$omp target enter data map(always,alloc:poly_coef_cbL_x)
545# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
546#endif
547#ifdef MFC_DEBUG
548# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
549 block
550# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
551 use iso_fortran_env, only: output_unit
552# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
553
554# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
555 print *, 'm_weno.fpp:110: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
556# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
557
558# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
559 call flush (output_unit)
560# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
561 end block
562# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
563#endif
564# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
565 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
566# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
567
568# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
569
570# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
571#if defined(MFC_OpenACC)
572# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
573!$acc enter data create(poly_coef_cbR_x)
574# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
575#elif defined(MFC_OpenMP)
576# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
577!$omp target enter data map(always,alloc:poly_coef_cbR_x)
578# 110 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
579#endif
580
581#ifdef MFC_DEBUG
582# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
583 block
584# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
585 use iso_fortran_env, only: output_unit
586# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
587
588# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
589 print *, 'm_weno.fpp:112: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
590# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
591
592# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
593 call flush (output_unit)
594# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
595 end block
596# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
597#endif
598# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
600# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601
602# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
603
604# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
605#if defined(MFC_OpenACC)
606# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607!$acc enter data create(d_cbL_x)
608# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
609#elif defined(MFC_OpenMP)
610# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
611!$omp target enter data map(always,alloc:d_cbL_x)
612# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
613#endif
614#ifdef MFC_DEBUG
615# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
616 block
617# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
618 use iso_fortran_env, only: output_unit
619# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
620
621# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
622 print *, 'm_weno.fpp:113: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
623# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
624
625# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
626 call flush (output_unit)
627# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
628 end block
629# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
630#endif
631# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
632 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
633# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
634
635# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
636
637# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
638#if defined(MFC_OpenACC)
639# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
640!$acc enter data create(d_cbR_x)
641# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
642#elif defined(MFC_OpenMP)
643# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
644!$omp target enter data map(always,alloc:d_cbR_x)
645# 113 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
646#endif
647
648#ifdef MFC_DEBUG
649# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
650 block
651# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
652 use iso_fortran_env, only: output_unit
653# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
654
655# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
656 print *, 'm_weno.fpp:115: ', '@:ALLOCATE(beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
657# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
658
659# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
660 call flush (output_unit)
661# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
662 end block
663# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
664#endif
665# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
666 allocate (beta_coef_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
667# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
668
669# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
670
671# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672#if defined(MFC_OpenACC)
673# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674!$acc enter data create(beta_coef_x)
675# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676#elif defined(MFC_OpenMP)
677# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678!$omp target enter data map(always,alloc:beta_coef_x)
679# 115 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680#endif
681# 117 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
682 ! Number of cross terms for dvd = (k-1)(k-1+1)/2, where weno_polyn = k-1 Note: k-1 not k because we are using value
683 ! differences (dvd) not the values themselves
684
685 call s_compute_weno_coefficients(1, is1_weno)
686
687#ifdef MFC_DEBUG
688# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
689 block
690# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
691 use iso_fortran_env, only: output_unit
692# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
693
694# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
695 print *, 'm_weno.fpp:122: ', '@:ALLOCATE(v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
696# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
697
698# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
699 call flush (output_unit)
700# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
701 end block
702# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
703#endif
704# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
705 allocate (v_rs_weno(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
706# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
707
708# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
709
710# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
711#if defined(MFC_OpenACC)
712# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
713!$acc enter data create(v_rs_weno)
714# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
715#elif defined(MFC_OpenMP)
716# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
717!$omp target enter data map(always,alloc:v_rs_weno)
718# 122 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
719#endif
720
721 ! Allocating/Computing WENO Coefficients in y-direction
722 if (n == 0) return
723
724 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
725 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
726
727 if (p == 0) then
728 is3_weno%beg = 0
729 else
730 is3_weno%beg = -buff_size
731 end if
732
733 is3_weno%end = p - is3_weno%beg
734
735#ifdef MFC_DEBUG
736# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
737 block
738# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
739 use iso_fortran_env, only: output_unit
740# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
741
742# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
743 print *, 'm_weno.fpp:138: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
744# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
745
746# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
747 call flush (output_unit)
748# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
749 end block
750# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
751#endif
752# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
754# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755
756# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
757
758# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
759#if defined(MFC_OpenACC)
760# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761!$acc enter data create(poly_coef_cbL_y)
762# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763#elif defined(MFC_OpenMP)
764# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
765!$omp target enter data map(always,alloc:poly_coef_cbL_y)
766# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
767#endif
768#ifdef MFC_DEBUG
769# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
770 block
771# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
772 use iso_fortran_env, only: output_unit
773# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
774
775# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
776 print *, 'm_weno.fpp:139: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
777# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
778
779# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
780 call flush (output_unit)
781# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
782 end block
783# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
784#endif
785# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
786 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
787# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
788
789# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
790
791# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
792#if defined(MFC_OpenACC)
793# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
794!$acc enter data create(poly_coef_cbR_y)
795# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
796#elif defined(MFC_OpenMP)
797# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
798!$omp target enter data map(always,alloc:poly_coef_cbR_y)
799# 139 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
800#endif
801
802#ifdef MFC_DEBUG
803# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
804 block
805# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
806 use iso_fortran_env, only: output_unit
807# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
808
809# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
810 print *, 'm_weno.fpp:141: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
811# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
812
813# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
814 call flush (output_unit)
815# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
816 end block
817# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
818#endif
819# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
820 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
821# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
822
823# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
824
825# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
826#if defined(MFC_OpenACC)
827# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
828!$acc enter data create(d_cbL_y)
829# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
830#elif defined(MFC_OpenMP)
831# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
832!$omp target enter data map(always,alloc:d_cbL_y)
833# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
834#endif
835#ifdef MFC_DEBUG
836# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
837 block
838# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
839 use iso_fortran_env, only: output_unit
840# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
841
842# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
843 print *, 'm_weno.fpp:142: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
844# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
845
846# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
847 call flush (output_unit)
848# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
849 end block
850# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
851#endif
852# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
853 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
854# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
855
856# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
857
858# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
859#if defined(MFC_OpenACC)
860# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
861!$acc enter data create(d_cbR_y)
862# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
863#elif defined(MFC_OpenMP)
864# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
865!$omp target enter data map(always,alloc:d_cbR_y)
866# 142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
867#endif
868
869#ifdef MFC_DEBUG
870# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
871 block
872# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
873 use iso_fortran_env, only: output_unit
874# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
875
876# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
877 print *, 'm_weno.fpp:144: ', '@:ALLOCATE(beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
878# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
879
880# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
881 call flush (output_unit)
882# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
883 end block
884# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
885#endif
886# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
887 allocate (beta_coef_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
888# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
889
890# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
891
892# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
893#if defined(MFC_OpenACC)
894# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
895!$acc enter data create(beta_coef_y)
896# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
897#elif defined(MFC_OpenMP)
898# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
899!$omp target enter data map(always,alloc:beta_coef_y)
900# 144 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
901#endif
902# 146 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
903
904 call s_compute_weno_coefficients(2, is2_weno)
905
906 ! Allocating/Computing WENO Coefficients in z-direction
907 if (p == 0) return
908
909 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
910 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
911 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
912
913#ifdef MFC_DEBUG
914# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
915 block
916# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
917 use iso_fortran_env, only: output_unit
918# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
919
920# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
921 print *, 'm_weno.fpp:156: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
922# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
923
924# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
925 call flush (output_unit)
926# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
927 end block
928# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
929#endif
930# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
931 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
932# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
933
934# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
935
936# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
937#if defined(MFC_OpenACC)
938# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
939!$acc enter data create(poly_coef_cbL_z)
940# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
941#elif defined(MFC_OpenMP)
942# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
943!$omp target enter data map(always,alloc:poly_coef_cbL_z)
944# 156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
945#endif
946#ifdef MFC_DEBUG
947# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
948 block
949# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950 use iso_fortran_env, only: output_unit
951# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
952
953# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
954 print *, 'm_weno.fpp:157: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
955# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956
957# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958 call flush (output_unit)
959# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960 end block
961# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962#endif
963# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
964 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
965# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
966
967# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
968
969# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
970#if defined(MFC_OpenACC)
971# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
972!$acc enter data create(poly_coef_cbR_z)
973# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
974#elif defined(MFC_OpenMP)
975# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
976!$omp target enter data map(always,alloc:poly_coef_cbR_z)
977# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
978#endif
979
980#ifdef MFC_DEBUG
981# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
982 block
983# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
984 use iso_fortran_env, only: output_unit
985# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
986
987# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
988 print *, 'm_weno.fpp:159: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
989# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
990
991# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
992 call flush (output_unit)
993# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
994 end block
995# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
996#endif
997# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
998 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
999# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1000
1001# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1002
1003# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1004#if defined(MFC_OpenACC)
1005# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1006!$acc enter data create(d_cbL_z)
1007# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1008#elif defined(MFC_OpenMP)
1009# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1010!$omp target enter data map(always,alloc:d_cbL_z)
1011# 159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1012#endif
1013#ifdef MFC_DEBUG
1014# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1015 block
1016# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1017 use iso_fortran_env, only: output_unit
1018# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1019
1020# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1021 print *, 'm_weno.fpp:160: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1022# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023
1024# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025 call flush (output_unit)
1026# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027 end block
1028# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1029#endif
1030# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1031 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1032# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1033
1034# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1035
1036# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1037#if defined(MFC_OpenACC)
1038# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1039!$acc enter data create(d_cbR_z)
1040# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1041#elif defined(MFC_OpenMP)
1042# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1043!$omp target enter data map(always,alloc:d_cbR_z)
1044# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1045#endif
1046
1047#ifdef MFC_DEBUG
1048# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1049 block
1050# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1051 use iso_fortran_env, only: output_unit
1052# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1053
1054# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1055 print *, 'm_weno.fpp:162: ', '@:ALLOCATE(beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))'
1056# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1057
1058# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1059 call flush (output_unit)
1060# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1061 end block
1062# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1063#endif
1064# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1065 allocate (beta_coef_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn*(weno_polyn + 1)/2 - 1))
1066# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1067
1068# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1069
1070# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1071#if defined(MFC_OpenACC)
1072# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1073!$acc enter data create(beta_coef_z)
1074# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1075#elif defined(MFC_OpenMP)
1076# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1077!$omp target enter data map(always,alloc:beta_coef_z)
1078# 162 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1079#endif
1080# 164 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1081
1082 call s_compute_weno_coefficients(3, is3_weno)
1083
1084 end subroutine s_initialize_weno_module
1085
1086 !> Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction
1087 subroutine s_compute_weno_coefficients(weno_dir, is)
1088
1089 ! Compute WENO coefficients for a given coordinate direction. Shu (1997)
1090 integer, intent(in) :: weno_dir
1091 type(int_bounds_info), intent(in) :: is
1092 integer :: s
1093 real(wp), pointer, dimension(:) :: s_cb => null() !< Cell-boundary locations in the s-direction
1094 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1095 integer :: i !< Generic loop iterator
1096 real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil
1097 real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1098 real(wp) :: h0 !< Reference spacing for uniform-grid detection
1099
1100 ! Determine cell count, boundary locations, and BCs for selected WENO direction
1101
1102 if (weno_dir == 1) then
1103 s = m; s_cb => x_cb; bc_s = bc_x
1104 else if (weno_dir == 2) then
1105 s = n; s_cb => y_cb; bc_s = bc_y
1106 else
1107 s = p; s_cb => z_cb; bc_s = bc_z
1108 end if
1109
1110# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1111 ! Computing WENO3 Coefficients
1112 if (weno_dir == 1) then
1113 if (weno_order == 3) then
1114 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1115 ! Polynomial reconstruction coefficients
1116 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1117 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1118
1119 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1120 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1121
1122 ! Ideal (linear) weights
1123 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1124 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1125
1126 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1127 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1128
1129 ! Smoothness indicator coefficients
1130 beta_coef_x(i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i) - s_cb(i + 2))**2._wp
1131 beta_coef_x(i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/(s_cb(i - 1) - s_cb(i + 1))**2._wp
1132 end do
1133
1134 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1135 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1136 if (null_weights) then
1137 if (bc_s%beg == bc_riemann_extrap) then
1138 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1139 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1140 end if
1141
1142 if (bc_s%end == bc_riemann_extrap) then
1143 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1144 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1145 end if
1146 end if
1147 ! END: Computing WENO3 Coefficients
1148
1149 ! Computing WENO5 Coefficients
1150 else if (weno_order == 5) then
1151 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1152 ! Polynomial reconstruction coefficients
1153 poly_coef_cbr_x(i + 1, 0, &
1154 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1155 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1156 poly_coef_cbr_x(i + 1, 1, &
1157 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1158 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1159 poly_coef_cbr_x(i + 1, 1, &
1160 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1161 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1162 poly_coef_cbr_x(i + 1, 2, &
1163 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1164 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1165 poly_coef_cbl_x(i + 1, 0, &
1166 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1167 & *(s_cb(i + 3) - s_cb(i + 1)))
1168 poly_coef_cbl_x(i + 1, 1, &
1169 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1170 & + 2))*(s_cb(i) - s_cb(i + 2)))
1171 poly_coef_cbl_x(i + 1, 1, &
1172 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1173 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1174 poly_coef_cbl_x(i + 1, 2, &
1175 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1176 & *(s_cb(i - 2) - s_cb(i + 1)))
1177
1178 poly_coef_cbr_x(i + 1, 0, &
1179 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1180 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1181 poly_coef_cbr_x(i + 1, 2, &
1182 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1183 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1184 poly_coef_cbl_x(i + 1, 0, &
1185 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1186 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1187 poly_coef_cbl_x(i + 1, 2, &
1188 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1189 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1190
1191 ! Ideal (linear) weights
1192 d_cbr_x(0, &
1193 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1194 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1195 d_cbr_x(2, &
1196 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1197 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1198 d_cbl_x(0, &
1199 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1200 & *(s_cb(i + 3) - s_cb(i - 1)))
1201 d_cbl_x(2, &
1202 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1203 & *(s_cb(i - 2) - s_cb(i + 3)))
1204
1205 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1206 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1207
1208 ! Smoothness indicator coefficients
1209 beta_coef_x(i + 1, 0, &
1210 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1211 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1212 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1213
1214 beta_coef_x(i + 1, 0, &
1215 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1216 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1217 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1218 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1219
1220 beta_coef_x(i + 1, 0, &
1221 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1222 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1223 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1224 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1225
1226 beta_coef_x(i + 1, 1, &
1227 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1228 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1229 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1230
1231 beta_coef_x(i + 1, 1, &
1232 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1233 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1234 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1235 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1236
1237 beta_coef_x(i + 1, 1, &
1238 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1239 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1240 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1241
1242 beta_coef_x(i + 1, 2, &
1243 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1244 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1245 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1246 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1247
1248 beta_coef_x(i + 1, 2, &
1249 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1250 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1251 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1252 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1253
1254 beta_coef_x(i + 1, 2, &
1255 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1256 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1257 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1258 end do
1259
1260 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1261 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1262 if (null_weights) then
1263 if (bc_s%beg == bc_riemann_extrap) then
1264 d_cbr_x(1:2,0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1265 d_cbl_x(1:2,0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1266 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:,1) = d_cbr_x(:,1)/sum(d_cbr_x(:,1))
1267 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:,1) = d_cbl_x(:,1)/sum(d_cbl_x(:,1))
1268 end if
1269
1270 if (bc_s%end == bc_riemann_extrap) then
1271 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:,s - 1) = d_cbr_x(:, &
1272 & s - 1)/sum(d_cbr_x(:,s - 1))
1273 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:,s - 1) = d_cbl_x(:, &
1274 & s - 1)/sum(d_cbl_x(:,s - 1))
1275 d_cbr_x(0:1,s) = 0._wp; d_cbr_x(2, s) = 1._wp
1276 d_cbl_x(0:1,s) = 0._wp; d_cbl_x(2, s) = 1._wp
1277 end if
1278 end if
1279 else
1280 if (.not. teno) then
1281 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1282 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1283 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1284 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1285 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1286 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1287 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1288 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1289 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1290 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1291 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1292 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1293
1294 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1295 d_cbr_x(0, &
1296 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1297 & *(w(1) - w(8)))
1298 d_cbr_x(1, &
1299 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1300 & *w(7) - w(2)*w(6) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) + w(6)*w(7) + w(6)*w(8) + w(7) &
1301 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1302 & *(w(2) - w(8)))
1303 d_cbr_x(2, &
1304 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1305 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
1306 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1307 & *(w(3) - w(8)))
1308 d_cbr_x(3, &
1309 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1310 & *(w(3) - w(8)))
1311
1312 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1313 d_cbl_x(0, &
1314 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1315 & *(w(3) - w(8)))
1316 d_cbl_x(1, &
1317 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1318 & *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) &
1319 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1320 & *(w(3) - w(8)))
1321 d_cbl_x(2, &
1322 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1323 & *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) &
1324 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1325 & *(w(2) - w(8)))
1326 d_cbl_x(3, &
1327 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1328 & *(w(1) - w(8)))
1329 ! Note: Left has the reversed order of both points and coefficients compared to the right
1330
1331 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1332 poly_coef_cbr_x(i + 1, 0, &
1333 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1334 & + y(2) + y(3) + y(4)))
1335 poly_coef_cbr_x(i + 1, 0, &
1336 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1337 & + 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) &
1338 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1339 poly_coef_cbr_x(i + 1, 0, &
1340 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1341 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1342 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1343
1344 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1345 poly_coef_cbr_x(i + 1, 1, &
1346 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1347 & + y(2) + y(3) + y(4)))
1348 poly_coef_cbr_x(i + 1, 1, &
1349 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1350 & + 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) &
1351 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1352 poly_coef_cbr_x(i + 1, 1, &
1353 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1354 & + y(2) + y(3) + y(4)))
1355
1356 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1357 poly_coef_cbr_x(i + 1, 2, &
1358 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1359 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1360 poly_coef_cbr_x(i + 1, 2, &
1361 & 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 &
1362 & + 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) &
1363 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1364 poly_coef_cbr_x(i + 1, 2, &
1365 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1366 & + y(2) + y(3) + y(4)))
1367
1368 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1369 poly_coef_cbr_x(i + 1, 3, &
1370 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1371 & + 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) &
1372 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1373 poly_coef_cbr_x(i + 1, 3, &
1374 & 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) &
1375 & + 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)) &
1376 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1377 & + y(4)))
1378 poly_coef_cbr_x(i + 1, 3, &
1379 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1380 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1381
1382 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1383 poly_coef_cbl_x(i + 1, 3, &
1384 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1385 & + y(2) + y(3) + y(4)))
1386 poly_coef_cbl_x(i + 1, 3, &
1387 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1388 & + 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) &
1389 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1390 poly_coef_cbl_x(i + 1, 3, &
1391 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1392 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1393 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1394
1395 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1396 poly_coef_cbl_x(i + 1, 2, &
1397 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1398 & + y(2) + y(3) + y(4)))
1399 poly_coef_cbl_x(i + 1, 2, &
1400 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1401 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
1402 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1403 poly_coef_cbl_x(i + 1, 2, &
1404 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1405 & + y(2) + y(3) + y(4)))
1406
1407 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1408 poly_coef_cbl_x(i + 1, 1, &
1409 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1410 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1411 poly_coef_cbl_x(i + 1, 1, &
1412 & 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 &
1413 & + 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) &
1414 & + 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, 1, &
1416 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1417 & + y(2) + y(3) + y(4)))
1418
1419 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1420 poly_coef_cbl_x(i + 1, 0, &
1421 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1422 & + 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) &
1423 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1424 poly_coef_cbl_x(i + 1, 0, &
1425 & 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) &
1426 & + 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)) &
1427 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1428 & + y(4)))
1429 poly_coef_cbl_x(i + 1, 0, &
1430 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1431 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1432
1433 poly_coef_cbl_x(i + 1,:,:) = -poly_coef_cbl_x(i + 1,:,:)
1434 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1435
1436 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1437 beta_coef_x(i + 1, 3, &
1438 & 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) &
1439 & + 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) &
1440 & **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 &
1441 & + 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) &
1442 & *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) &
1443 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
1444 & + 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) &
1445 & *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) &
1446 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
1447 & **2*(y(1) + y(2) + y(3) + y(4))**2)
1448 beta_coef_x(i + 1, 3, &
1449 & 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) &
1450 & **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) &
1451 & + 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) &
1452 & + 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) &
1453 & + 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) &
1454 & *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) &
1455 & *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) &
1456 & *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) &
1457 & **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) &
1458 & **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) &
1459 & *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) &
1460 & + 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) &
1461 & *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) &
1462 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
1463 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
1464 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1465 beta_coef_x(i + 1, 3, &
1466 & 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) &
1467 & **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) &
1468 & + 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) &
1469 & *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 &
1470 & + 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) &
1471 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
1472 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1473 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1474 beta_coef_x(i + 1, 3, &
1475 & 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 &
1476 & + 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 &
1477 & + 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 &
1478 & + 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) &
1479 & + 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) &
1480 & **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) &
1481 & **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) &
1482 & **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) &
1483 & **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) &
1484 & *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) &
1485 & **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) &
1486 & **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) &
1487 & **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) &
1488 & **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) &
1489 & **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) &
1490 & **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) &
1491 & **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) &
1492 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
1493 & + 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 &
1494 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
1495 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
1496 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1497 & + y(3) + y(4))**2)
1498 beta_coef_x(i + 1, 3, &
1499 & 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) &
1500 & **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) &
1501 & **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) &
1502 & **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) &
1503 & *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) &
1504 & *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) &
1505 & **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) &
1506 & **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) &
1507 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
1508 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
1509 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
1510 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1511 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1512 beta_coef_x(i + 1, 3, &
1513 & 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 &
1514 & + 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) &
1515 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
1516 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
1517 & + y(4))**2)
1518
1519 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1520 beta_coef_x(i + 1, 2, &
1521 & 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 &
1522 & + 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) &
1523 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
1524 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
1525 & + y(4))**2)
1526 beta_coef_x(i + 1, 2, &
1527 & 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 &
1528 & + 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) &
1529 & - 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 &
1530 & - 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 &
1531 & + 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 &
1532 & + 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 &
1533 & + 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 &
1534 & + 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) &
1535 & **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 &
1536 & - 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 &
1537 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
1538 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
1539 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
1540 & **2)
1541 beta_coef_x(i + 1, 2, &
1542 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
1543 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
1544 & + 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) &
1545 & *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)) &
1546 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1547 & + y(4))**2)
1548 beta_coef_x(i + 1, 2, &
1549 & 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 &
1550 & + 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 &
1551 & + 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 &
1552 & + 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) &
1553 & + 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) &
1554 & **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) &
1555 & **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) &
1556 & **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) &
1557 & **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) &
1558 & *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 &
1559 & + 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) &
1560 & **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 &
1561 & + 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 &
1562 & + 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) &
1563 & **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) &
1564 & *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) &
1565 & + 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 &
1566 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
1567 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
1568 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
1569 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1570 & + y(3) + y(4))**2)
1571 beta_coef_x(i + 1, 2, &
1572 & 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) &
1573 & **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) &
1574 & *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) &
1575 & *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) &
1576 & *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) &
1577 & **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) &
1578 & **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) &
1579 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
1580 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
1581 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
1582 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
1583 & **2)
1584 beta_coef_x(i + 1, 2, &
1585 & 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 &
1586 & - 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)) &
1587 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
1588
1589 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1590 beta_coef_x(i + 1, 1, &
1591 & 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 &
1592 & - 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)) &
1593 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1594 beta_coef_x(i + 1, 1, &
1595 & 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) &
1596 & *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) &
1597 & **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) &
1598 & **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) &
1599 & **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) &
1600 & **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) &
1601 & **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) &
1602 & *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) &
1603 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
1604 & **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) &
1605 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1606 & + y(3) + y(4))**2)
1607 beta_coef_x(i + 1, 1, &
1608 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
1609 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
1610 & + 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) &
1611 & *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)) &
1612 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1613 & + y(4))**2)
1614 beta_coef_x(i + 1, 1, &
1615 & 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) &
1616 & + 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) &
1617 & **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) &
1618 & **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) &
1619 & **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) &
1620 & **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) &
1621 & + 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) &
1622 & **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) &
1623 & **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) &
1624 & **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) &
1625 & **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) &
1626 & - 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) &
1627 & **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) &
1628 & **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) &
1629 & *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) &
1630 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
1631 & **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) &
1632 & **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) &
1633 & **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) &
1634 & **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) &
1635 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1636 beta_coef_x(i + 1, 1, &
1637 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
1638 & **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) &
1639 & **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) &
1640 & *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) &
1641 & + 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) &
1642 & **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) &
1643 & **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) &
1644 & **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) &
1645 & **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 &
1646 & - 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 &
1647 & - 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) &
1648 & **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) &
1649 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1650 beta_coef_x(i + 1, 1, &
1651 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
1652 & **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 &
1653 & + 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) &
1654 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1655 & + y(3) + y(4))**2)
1656
1657 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1658 beta_coef_x(i + 1, 0, &
1659 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
1660 & **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 &
1661 & + 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) &
1662 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1663 & + y(3) + y(4))**2)
1664 beta_coef_x(i + 1, 0, &
1665 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
1666 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
1667 & **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) &
1668 & **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) &
1669 & + 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) &
1670 & **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 &
1671 & + 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) &
1672 & **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) &
1673 & *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 &
1674 & + 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) &
1675 & + 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) &
1676 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1677 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1678 beta_coef_x(i + 1, 0, &
1679 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
1680 & *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) &
1681 & + 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) &
1682 & **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) &
1683 & + 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) &
1684 & *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) &
1685 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
1686 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1687 beta_coef_x(i + 1, 0, &
1688 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
1689 & **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) &
1690 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
1691 & + 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) &
1692 & + 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) &
1693 & *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) &
1694 & *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) &
1695 & + 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) &
1696 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
1697 & + 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) &
1698 & **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) &
1699 & **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) &
1700 & *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) &
1701 & **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) &
1702 & **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 &
1703 & + 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) &
1704 & + 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 &
1705 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
1706 & + 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) &
1707 & **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) &
1708 & **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) &
1709 & **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)) &
1710 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1711 beta_coef_x(i + 1, 0, &
1712 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
1713 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
1714 & **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) &
1715 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
1716 & **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) &
1717 & **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) &
1718 & **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) &
1719 & + 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) &
1720 & + 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) &
1721 & + 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) &
1722 & *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 &
1723 & + 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) &
1724 & *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) &
1725 & + 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) &
1726 & **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)) &
1727 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1728 & + y(4))**2)
1729 beta_coef_x(i + 1, 0, &
1730 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
1731 & **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) &
1732 & + 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) &
1733 & *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 &
1734 & + 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) &
1735 & **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) &
1736 & + 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) &
1737 & **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) &
1738 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1739 & + y(3) + y(4))**2)
1740 end do
1741 else
1742 ! (Fu, et al., 2016) Table 2 (for right flux)
1743 d_cbl_x(0,:) = 18._wp/35._wp
1744 d_cbl_x(1,:) = 3._wp/35._wp
1745 d_cbl_x(2,:) = 9._wp/35._wp
1746 d_cbl_x(3,:) = 1._wp/35._wp
1747 d_cbl_x(4,:) = 4._wp/35._wp
1748
1749 d_cbr_x(0,:) = 18._wp/35._wp
1750 d_cbr_x(1,:) = 9._wp/35._wp
1751 d_cbr_x(2,:) = 3._wp/35._wp
1752 d_cbr_x(3,:) = 4._wp/35._wp
1753 d_cbr_x(4,:) = 1._wp/35._wp
1754 end if
1755 end if
1756 end if
1757# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1758 ! Computing WENO3 Coefficients
1759 if (weno_dir == 2) then
1760 if (weno_order == 3) then
1761 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1762 ! Polynomial reconstruction coefficients
1763 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1764 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1765
1766 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1767 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1768
1769 ! Ideal (linear) weights
1770 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1771 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1772
1773 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1774 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1775
1776 ! Smoothness indicator coefficients
1777 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
1778 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
1779 end do
1780
1781 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1782 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1783 if (null_weights) then
1784 if (bc_s%beg == bc_riemann_extrap) then
1785 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1786 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1787 end if
1788
1789 if (bc_s%end == bc_riemann_extrap) then
1790 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1791 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1792 end if
1793 end if
1794 ! END: Computing WENO3 Coefficients
1795
1796 ! Computing WENO5 Coefficients
1797 else if (weno_order == 5) 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, &
1801 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1802 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1803 poly_coef_cbr_y(i + 1, 1, &
1804 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1805 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1806 poly_coef_cbr_y(i + 1, 1, &
1807 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1808 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1809 poly_coef_cbr_y(i + 1, 2, &
1810 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1811 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1812 poly_coef_cbl_y(i + 1, 0, &
1813 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1814 & *(s_cb(i + 3) - s_cb(i + 1)))
1815 poly_coef_cbl_y(i + 1, 1, &
1816 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1817 & + 2))*(s_cb(i) - s_cb(i + 2)))
1818 poly_coef_cbl_y(i + 1, 1, &
1819 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1820 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1821 poly_coef_cbl_y(i + 1, 2, &
1822 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1823 & *(s_cb(i - 2) - s_cb(i + 1)))
1824
1825 poly_coef_cbr_y(i + 1, 0, &
1826 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1827 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1828 poly_coef_cbr_y(i + 1, 2, &
1829 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1830 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1831 poly_coef_cbl_y(i + 1, 0, &
1832 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1833 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1834 poly_coef_cbl_y(i + 1, 2, &
1835 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1836 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1837
1838 ! Ideal (linear) weights
1839 d_cbr_y(0, &
1840 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1841 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1842 d_cbr_y(2, &
1843 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1844 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1845 d_cbl_y(0, &
1846 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1847 & *(s_cb(i + 3) - s_cb(i - 1)))
1848 d_cbl_y(2, &
1849 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1850 & *(s_cb(i - 2) - s_cb(i + 3)))
1851
1852 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1853 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1854
1855 ! Smoothness indicator coefficients
1856 beta_coef_y(i + 1, 0, &
1857 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1858 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1859 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1860
1861 beta_coef_y(i + 1, 0, &
1862 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1863 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1864 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1865 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1866
1867 beta_coef_y(i + 1, 0, &
1868 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1869 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1870 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1871 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1872
1873 beta_coef_y(i + 1, 1, &
1874 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1875 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1876 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1877
1878 beta_coef_y(i + 1, 1, &
1879 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1880 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1881 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1882 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1883
1884 beta_coef_y(i + 1, 1, &
1885 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1886 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1887 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1888
1889 beta_coef_y(i + 1, 2, &
1890 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1891 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1892 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1893 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1894
1895 beta_coef_y(i + 1, 2, &
1896 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1897 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1898 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1899 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1900
1901 beta_coef_y(i + 1, 2, &
1902 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1903 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1904 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1905 end do
1906
1907 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1908 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1909 if (null_weights) then
1910 if (bc_s%beg == bc_riemann_extrap) then
1911 d_cbr_y(1:2,0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1912 d_cbl_y(1:2,0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1913 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:,1) = d_cbr_y(:,1)/sum(d_cbr_y(:,1))
1914 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:,1) = d_cbl_y(:,1)/sum(d_cbl_y(:,1))
1915 end if
1916
1917 if (bc_s%end == bc_riemann_extrap) then
1918 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:,s - 1) = d_cbr_y(:, &
1919 & s - 1)/sum(d_cbr_y(:,s - 1))
1920 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:,s - 1) = d_cbl_y(:, &
1921 & s - 1)/sum(d_cbl_y(:,s - 1))
1922 d_cbr_y(0:1,s) = 0._wp; d_cbr_y(2, s) = 1._wp
1923 d_cbl_y(0:1,s) = 0._wp; d_cbl_y(2, s) = 1._wp
1924 end if
1925 end if
1926 else
1927 if (.not. teno) then
1928 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1929 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1930 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1931 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1932 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1933 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1934 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1935 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1936 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1937 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1938 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1939 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1940
1941 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1942 d_cbr_y(0, &
1943 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1944 & *(w(1) - w(8)))
1945 d_cbr_y(1, &
1946 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1947 & *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) &
1948 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1949 & *(w(2) - w(8)))
1950 d_cbr_y(2, &
1951 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1952 & *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) &
1953 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1954 & *(w(3) - w(8)))
1955 d_cbr_y(3, &
1956 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1957 & *(w(3) - w(8)))
1958
1959 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1960 d_cbl_y(0, &
1961 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1962 & *(w(3) - w(8)))
1963 d_cbl_y(1, &
1964 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1965 & *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) &
1966 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1967 & *(w(3) - w(8)))
1968 d_cbl_y(2, &
1969 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1970 & *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) &
1971 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1972 & *(w(2) - w(8)))
1973 d_cbl_y(3, &
1974 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1975 & *(w(1) - w(8)))
1976 ! Note: Left has the reversed order of both points and coefficients compared to the right
1977
1978 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1979 poly_coef_cbr_y(i + 1, 0, &
1980 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1981 & + y(2) + y(3) + y(4)))
1982 poly_coef_cbr_y(i + 1, 0, &
1983 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1984 & + 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) &
1985 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1986 poly_coef_cbr_y(i + 1, 0, &
1987 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1988 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1989 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1990
1991 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1992 poly_coef_cbr_y(i + 1, 1, &
1993 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1994 & + y(2) + y(3) + y(4)))
1995 poly_coef_cbr_y(i + 1, 1, &
1996 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1997 & + 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) &
1998 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1999 poly_coef_cbr_y(i + 1, 1, &
2000 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2001 & + y(2) + y(3) + y(4)))
2002
2003 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2004 poly_coef_cbr_y(i + 1, 2, &
2005 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2006 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2007 poly_coef_cbr_y(i + 1, 2, &
2008 & 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 &
2009 & + 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) &
2010 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2011 poly_coef_cbr_y(i + 1, 2, &
2012 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2013 & + y(2) + y(3) + y(4)))
2014
2015 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2016 poly_coef_cbr_y(i + 1, 3, &
2017 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2018 & + 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) &
2019 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2020 poly_coef_cbr_y(i + 1, 3, &
2021 & 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) &
2022 & + 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)) &
2023 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2024 & + y(4)))
2025 poly_coef_cbr_y(i + 1, 3, &
2026 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2027 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2028
2029 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2030 poly_coef_cbl_y(i + 1, 3, &
2031 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2032 & + y(2) + y(3) + y(4)))
2033 poly_coef_cbl_y(i + 1, 3, &
2034 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2035 & + 3*y(3)**2 + 3*y(3)*y(4) + 2*y(1)*y(3) + y(4)**2 + y(1)*y(4)))/((y(2) + y(3) &
2036 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2037 poly_coef_cbl_y(i + 1, 3, &
2038 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2039 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2040 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2041
2042 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2043 poly_coef_cbl_y(i + 1, 2, &
2044 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2045 & + y(2) + y(3) + y(4)))
2046 poly_coef_cbl_y(i + 1, 2, &
2047 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2048 & + 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) &
2049 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2050 poly_coef_cbl_y(i + 1, 2, &
2051 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2052 & + y(2) + y(3) + y(4)))
2053
2054 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2055 poly_coef_cbl_y(i + 1, 1, &
2056 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2057 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2058 poly_coef_cbl_y(i + 1, 1, &
2059 & 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 &
2060 & + 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) &
2061 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2062 poly_coef_cbl_y(i + 1, 1, &
2063 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2064 & + y(2) + y(3) + y(4)))
2065
2066 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2067 poly_coef_cbl_y(i + 1, 0, &
2068 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2069 & + 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) &
2070 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2071 poly_coef_cbl_y(i + 1, 0, &
2072 & 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) &
2073 & + 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)) &
2074 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2075 & + y(4)))
2076 poly_coef_cbl_y(i + 1, 0, &
2077 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2078 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2079
2080 poly_coef_cbl_y(i + 1,:,:) = -poly_coef_cbl_y(i + 1,:,:)
2081 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2082
2083 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2084 beta_coef_y(i + 1, 3, &
2085 & 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) &
2086 & + 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) &
2087 & **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 &
2088 & + 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) &
2089 & *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) &
2090 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2091 & + 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) &
2092 & *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) &
2093 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2094 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2095 beta_coef_y(i + 1, 3, &
2096 & 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) &
2097 & **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) &
2098 & + 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) &
2099 & + 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) &
2100 & + 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) &
2101 & *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) &
2102 & *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) &
2103 & *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) &
2104 & **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) &
2105 & **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) &
2106 & *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) &
2107 & + 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) &
2108 & *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) &
2109 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2110 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2111 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2112 beta_coef_y(i + 1, 3, &
2113 & 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) &
2114 & **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) &
2115 & + 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) &
2116 & *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 &
2117 & + 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) &
2118 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2119 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2120 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2121 beta_coef_y(i + 1, 3, &
2122 & 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 &
2123 & + 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 &
2124 & + 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 &
2125 & + 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) &
2126 & + 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) &
2127 & **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) &
2128 & **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) &
2129 & **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) &
2130 & **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) &
2131 & *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) &
2132 & **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) &
2133 & **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) &
2134 & **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) &
2135 & **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) &
2136 & **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) &
2137 & **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) &
2138 & **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) &
2139 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2140 & + 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 &
2141 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2142 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2143 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2144 & + y(3) + y(4))**2)
2145 beta_coef_y(i + 1, 3, &
2146 & 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) &
2147 & **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) &
2148 & **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) &
2149 & **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) &
2150 & *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) &
2151 & *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) &
2152 & **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) &
2153 & **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) &
2154 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2155 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2156 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2157 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2158 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2159 beta_coef_y(i + 1, 3, &
2160 & 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 &
2161 & + 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) &
2162 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2163 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2164 & + y(4))**2)
2165
2166 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2167 beta_coef_y(i + 1, 2, &
2168 & 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 &
2169 & + 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) &
2170 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2171 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2172 & + y(4))**2)
2173 beta_coef_y(i + 1, 2, &
2174 & 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 &
2175 & + 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) &
2176 & - 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 &
2177 & - 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 &
2178 & + 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 &
2179 & + 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 &
2180 & + 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 &
2181 & + 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) &
2182 & **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 &
2183 & - 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 &
2184 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2185 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2186 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2187 & **2)
2188 beta_coef_y(i + 1, 2, &
2189 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2190 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2191 & + 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) &
2192 & *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)) &
2193 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2194 & + y(4))**2)
2195 beta_coef_y(i + 1, 2, &
2196 & 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 &
2197 & + 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 &
2198 & + 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 &
2199 & + 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) &
2200 & + 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) &
2201 & **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) &
2202 & **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) &
2203 & **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) &
2204 & **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) &
2205 & *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 &
2206 & + 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) &
2207 & **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 &
2208 & + 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 &
2209 & + 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) &
2210 & **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) &
2211 & *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) &
2212 & + 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 &
2213 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2214 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2215 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2216 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2217 & + y(3) + y(4))**2)
2218 beta_coef_y(i + 1, 2, &
2219 & 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) &
2220 & **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) &
2221 & *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) &
2222 & *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) &
2223 & *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) &
2224 & **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) &
2225 & **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) &
2226 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2227 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2228 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2229 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2230 & **2)
2231 beta_coef_y(i + 1, 2, &
2232 & 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 &
2233 & - 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)) &
2234 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2235
2236 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2237 beta_coef_y(i + 1, 1, &
2238 & 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 &
2239 & - 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)) &
2240 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2241 beta_coef_y(i + 1, 1, &
2242 & 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) &
2243 & *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) &
2244 & **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) &
2245 & **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) &
2246 & **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) &
2247 & **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) &
2248 & **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) &
2249 & *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) &
2250 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2251 & **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) &
2252 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2253 & + y(3) + y(4))**2)
2254 beta_coef_y(i + 1, 1, &
2255 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2256 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2257 & + 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) &
2258 & *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)) &
2259 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2260 & + y(4))**2)
2261 beta_coef_y(i + 1, 1, &
2262 & 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) &
2263 & + 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) &
2264 & **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) &
2265 & **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) &
2266 & **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) &
2267 & **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) &
2268 & + 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) &
2269 & **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) &
2270 & **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) &
2271 & **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) &
2272 & **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) &
2273 & - 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) &
2274 & **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) &
2275 & **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) &
2276 & *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) &
2277 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2278 & **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) &
2279 & **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) &
2280 & **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) &
2281 & **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) &
2282 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2283 beta_coef_y(i + 1, 1, &
2284 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2285 & **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) &
2286 & **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) &
2287 & *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) &
2288 & + 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) &
2289 & **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) &
2290 & **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) &
2291 & **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) &
2292 & **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 &
2293 & - 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 &
2294 & - 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) &
2295 & **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) &
2296 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2297 beta_coef_y(i + 1, 1, &
2298 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2299 & **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 &
2300 & + 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) &
2301 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2302 & + y(3) + y(4))**2)
2303
2304 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2305 beta_coef_y(i + 1, 0, &
2306 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2307 & **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 &
2308 & + 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) &
2309 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2310 & + y(3) + y(4))**2)
2311 beta_coef_y(i + 1, 0, &
2312 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2313 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2314 & **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) &
2315 & **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) &
2316 & + 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) &
2317 & **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 &
2318 & + 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) &
2319 & **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) &
2320 & *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 &
2321 & + 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) &
2322 & + 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) &
2323 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2324 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2325 beta_coef_y(i + 1, 0, &
2326 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2327 & *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) &
2328 & + 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) &
2329 & **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) &
2330 & + 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) &
2331 & *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) &
2332 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2333 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2334 beta_coef_y(i + 1, 0, &
2335 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2336 & **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) &
2337 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2338 & + 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) &
2339 & + 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) &
2340 & *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) &
2341 & *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) &
2342 & + 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) &
2343 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2344 & + 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) &
2345 & **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) &
2346 & **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) &
2347 & *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) &
2348 & **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) &
2349 & **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 &
2350 & + 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) &
2351 & + 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 &
2352 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2353 & + 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) &
2354 & **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) &
2355 & **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) &
2356 & **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)) &
2357 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2358 beta_coef_y(i + 1, 0, &
2359 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
2360 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
2361 & **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) &
2362 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
2363 & **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) &
2364 & **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) &
2365 & **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) &
2366 & + 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) &
2367 & + 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) &
2368 & + 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) &
2369 & *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 &
2370 & + 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) &
2371 & *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) &
2372 & + 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) &
2373 & **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)) &
2374 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2375 & + y(4))**2)
2376 beta_coef_y(i + 1, 0, &
2377 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
2378 & **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) &
2379 & + 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) &
2380 & *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 &
2381 & + 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) &
2382 & **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) &
2383 & + 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) &
2384 & **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) &
2385 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2386 & + y(3) + y(4))**2)
2387 end do
2388 else
2389 ! (Fu, et al., 2016) Table 2 (for right flux)
2390 d_cbl_y(0,:) = 18._wp/35._wp
2391 d_cbl_y(1,:) = 3._wp/35._wp
2392 d_cbl_y(2,:) = 9._wp/35._wp
2393 d_cbl_y(3,:) = 1._wp/35._wp
2394 d_cbl_y(4,:) = 4._wp/35._wp
2395
2396 d_cbr_y(0,:) = 18._wp/35._wp
2397 d_cbr_y(1,:) = 9._wp/35._wp
2398 d_cbr_y(2,:) = 3._wp/35._wp
2399 d_cbr_y(3,:) = 4._wp/35._wp
2400 d_cbr_y(4,:) = 1._wp/35._wp
2401 end if
2402 end if
2403 end if
2404# 194 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2405 ! Computing WENO3 Coefficients
2406 if (weno_dir == 3) then
2407 if (weno_order == 3) then
2408 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2409 ! Polynomial reconstruction coefficients
2410 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
2411 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
2412
2413 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
2414 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
2415
2416 ! Ideal (linear) weights
2417 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
2418 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
2419
2420 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
2421 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
2422
2423 ! Smoothness indicator coefficients
2424 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
2425 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
2426 end do
2427
2428 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2429 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2430 if (null_weights) then
2431 if (bc_s%beg == bc_riemann_extrap) then
2432 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2433 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2434 end if
2435
2436 if (bc_s%end == bc_riemann_extrap) then
2437 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
2438 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
2439 end if
2440 end if
2441 ! END: Computing WENO3 Coefficients
2442
2443 ! Computing WENO5 Coefficients
2444 else if (weno_order == 5) then
2445 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2446 ! Polynomial reconstruction coefficients
2447 poly_coef_cbr_z(i + 1, 0, &
2448 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
2449 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2450 poly_coef_cbr_z(i + 1, 1, &
2451 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
2452 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
2453 poly_coef_cbr_z(i + 1, 1, &
2454 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
2455 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2456 poly_coef_cbr_z(i + 1, 2, &
2457 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2458 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2459 poly_coef_cbl_z(i + 1, 0, &
2460 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
2461 & *(s_cb(i + 3) - s_cb(i + 1)))
2462 poly_coef_cbl_z(i + 1, 1, &
2463 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
2464 & + 2))*(s_cb(i) - s_cb(i + 2)))
2465 poly_coef_cbl_z(i + 1, 1, &
2466 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
2467 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2468 poly_coef_cbl_z(i + 1, 2, &
2469 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
2470 & *(s_cb(i - 2) - s_cb(i + 1)))
2471
2472 poly_coef_cbr_z(i + 1, 0, &
2473 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
2474 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
2475 poly_coef_cbr_z(i + 1, 2, &
2476 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
2477 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
2478 poly_coef_cbl_z(i + 1, 0, &
2479 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
2480 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
2481 poly_coef_cbl_z(i + 1, 2, &
2482 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
2483 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
2484
2485 ! Ideal (linear) weights
2486 d_cbr_z(0, &
2487 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2488 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2489 d_cbr_z(2, &
2490 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
2491 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2492 d_cbl_z(0, &
2493 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
2494 & *(s_cb(i + 3) - s_cb(i - 1)))
2495 d_cbl_z(2, &
2496 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
2497 & *(s_cb(i - 2) - s_cb(i + 3)))
2498
2499 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2500 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2501
2502 ! Smoothness indicator coefficients
2503 beta_coef_z(i + 1, 0, &
2504 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2505 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2506 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2507
2508 beta_coef_z(i + 1, 0, &
2509 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2510 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
2511 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
2512 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
2513
2514 beta_coef_z(i + 1, 0, &
2515 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2516 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
2517 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
2518 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2519
2520 beta_coef_z(i + 1, 1, &
2521 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2522 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2523 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2524
2525 beta_coef_z(i + 1, 1, &
2526 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
2527 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
2528 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
2529 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
2530
2531 beta_coef_z(i + 1, 1, &
2532 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2533 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2534 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
2535
2536 beta_coef_z(i + 1, 2, &
2537 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2538 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
2539 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
2540 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
2541
2542 beta_coef_z(i + 1, 2, &
2543 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2544 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
2545 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
2546 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
2547
2548 beta_coef_z(i + 1, 2, &
2549 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2550 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2551 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2552 end do
2553
2554 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2555 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2556 if (null_weights) then
2557 if (bc_s%beg == bc_riemann_extrap) then
2558 d_cbr_z(1:2,0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2559 d_cbl_z(1:2,0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2560 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:,1) = d_cbr_z(:,1)/sum(d_cbr_z(:,1))
2561 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:,1) = d_cbl_z(:,1)/sum(d_cbl_z(:,1))
2562 end if
2563
2564 if (bc_s%end == bc_riemann_extrap) then
2565 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:,s - 1) = d_cbr_z(:, &
2566 & s - 1)/sum(d_cbr_z(:,s - 1))
2567 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:,s - 1) = d_cbl_z(:, &
2568 & s - 1)/sum(d_cbl_z(:,s - 1))
2569 d_cbr_z(0:1,s) = 0._wp; d_cbr_z(2, s) = 1._wp
2570 d_cbl_z(0:1,s) = 0._wp; d_cbl_z(2, s) = 1._wp
2571 end if
2572 end if
2573 else
2574 if (.not. teno) then
2575 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2576 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
2577 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
2578 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
2579 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
2580 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
2581 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2582 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
2583 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
2584 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
2585 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
2586 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2587
2588 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2589 d_cbr_z(0, &
2590 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2591 & *(w(1) - w(8)))
2592 d_cbr_z(1, &
2593 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2594 & *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) &
2595 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2596 & *(w(2) - w(8)))
2597 d_cbr_z(2, &
2598 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2599 & *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) &
2600 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2601 & *(w(3) - w(8)))
2602 d_cbr_z(3, &
2603 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2604 & *(w(3) - w(8)))
2605
2606 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
2607 d_cbl_z(0, &
2608 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2609 & *(w(3) - w(8)))
2610 d_cbl_z(1, &
2611 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2612 & *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) &
2613 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2614 & *(w(3) - w(8)))
2615 d_cbl_z(2, &
2616 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2617 & *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) &
2618 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2619 & *(w(2) - w(8)))
2620 d_cbl_z(3, &
2621 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2622 & *(w(1) - w(8)))
2623 ! Note: Left has the reversed order of both points and coefficients compared to the right
2624
2625 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2626 poly_coef_cbr_z(i + 1, 0, &
2627 & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2628 & + y(2) + y(3) + y(4)))
2629 poly_coef_cbr_z(i + 1, 0, &
2630 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2631 & + 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) &
2632 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2633 poly_coef_cbr_z(i + 1, 0, &
2634 & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2635 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2636 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2637
2638 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2639 poly_coef_cbr_z(i + 1, 1, &
2640 & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2641 & + y(2) + y(3) + y(4)))
2642 poly_coef_cbr_z(i + 1, 1, &
2643 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2644 & + 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) &
2645 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2646 poly_coef_cbr_z(i + 1, 1, &
2647 & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2648 & + y(2) + y(3) + y(4)))
2649
2650 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2651 poly_coef_cbr_z(i + 1, 2, &
2652 & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2653 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2654 poly_coef_cbr_z(i + 1, 2, &
2655 & 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 &
2656 & + 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) &
2657 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2658 poly_coef_cbr_z(i + 1, 2, &
2659 & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2660 & + y(2) + y(3) + y(4)))
2661
2662 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2663 poly_coef_cbr_z(i + 1, 3, &
2664 & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2665 & + 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) &
2666 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2667 poly_coef_cbr_z(i + 1, 3, &
2668 & 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) &
2669 & + 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)) &
2670 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2671 & + y(4)))
2672 poly_coef_cbr_z(i + 1, 3, &
2673 & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2674 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2675
2676 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2677 poly_coef_cbl_z(i + 1, 3, &
2678 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2679 & + y(2) + y(3) + y(4)))
2680 poly_coef_cbl_z(i + 1, 3, &
2681 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2682 & + 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) &
2683 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2684 poly_coef_cbl_z(i + 1, 3, &
2685 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2686 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2687 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2688
2689 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2690 poly_coef_cbl_z(i + 1, 2, &
2691 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2692 & + y(2) + y(3) + y(4)))
2693 poly_coef_cbl_z(i + 1, 2, &
2694 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2695 & + 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) &
2696 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2697 poly_coef_cbl_z(i + 1, 2, &
2698 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2699 & + y(2) + y(3) + y(4)))
2700
2701 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2702 poly_coef_cbl_z(i + 1, 1, &
2703 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2704 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2705 poly_coef_cbl_z(i + 1, 1, &
2706 & 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 &
2707 & + 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) &
2708 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2709 poly_coef_cbl_z(i + 1, 1, &
2710 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2711 & + y(2) + y(3) + y(4)))
2712
2713 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2714 poly_coef_cbl_z(i + 1, 0, &
2715 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2716 & + 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) &
2717 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2718 poly_coef_cbl_z(i + 1, 0, &
2719 & 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) &
2720 & + 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)) &
2721 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2722 & + y(4)))
2723 poly_coef_cbl_z(i + 1, 0, &
2724 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2725 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2726
2727 poly_coef_cbl_z(i + 1,:,:) = -poly_coef_cbl_z(i + 1,:,:)
2728 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2729
2730 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2731 beta_coef_z(i + 1, 3, &
2732 & 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) &
2733 & + 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) &
2734 & **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 &
2735 & + 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) &
2736 & *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) &
2737 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2738 & + 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) &
2739 & *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) &
2740 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2741 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2742 beta_coef_z(i + 1, 3, &
2743 & 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) &
2744 & **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) &
2745 & + 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) &
2746 & + 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) &
2747 & + 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) &
2748 & *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) &
2749 & *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) &
2750 & *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) &
2751 & **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) &
2752 & **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) &
2753 & *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) &
2754 & + 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) &
2755 & *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) &
2756 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2757 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2758 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2759 beta_coef_z(i + 1, 3, &
2760 & 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) &
2761 & **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) &
2762 & + 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) &
2763 & *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 &
2764 & + 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) &
2765 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2766 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2767 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2768 beta_coef_z(i + 1, 3, &
2769 & 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 &
2770 & + 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 &
2771 & + 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 &
2772 & + 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) &
2773 & + 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) &
2774 & **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) &
2775 & **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) &
2776 & **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) &
2777 & **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) &
2778 & *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) &
2779 & **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) &
2780 & **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) &
2781 & **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) &
2782 & **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) &
2783 & **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) &
2784 & **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) &
2785 & **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) &
2786 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2787 & + 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 &
2788 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2789 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2790 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2791 & + y(3) + y(4))**2)
2792 beta_coef_z(i + 1, 3, &
2793 & 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) &
2794 & **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) &
2795 & **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) &
2796 & **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) &
2797 & *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) &
2798 & *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) &
2799 & **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) &
2800 & **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) &
2801 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2802 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2803 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2804 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2805 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2806 beta_coef_z(i + 1, 3, &
2807 & 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 &
2808 & + 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) &
2809 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2810 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2811 & + y(4))**2)
2812
2813 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2814 beta_coef_z(i + 1, 2, &
2815 & 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 &
2816 & + 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) &
2817 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2818 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2819 & + y(4))**2)
2820 beta_coef_z(i + 1, 2, &
2821 & 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 &
2822 & + 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) &
2823 & - 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 &
2824 & - 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 &
2825 & + 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 &
2826 & + 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 &
2827 & + 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 &
2828 & + 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) &
2829 & **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 &
2830 & - 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 &
2831 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2832 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2833 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2834 & **2)
2835 beta_coef_z(i + 1, 2, &
2836 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2837 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2838 & + 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) &
2839 & *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)) &
2840 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2841 & + y(4))**2)
2842 beta_coef_z(i + 1, 2, &
2843 & 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 &
2844 & + 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 &
2845 & + 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 &
2846 & + 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) &
2847 & + 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) &
2848 & **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) &
2849 & **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) &
2850 & **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) &
2851 & **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) &
2852 & *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 &
2853 & + 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) &
2854 & **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 &
2855 & + 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 &
2856 & + 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) &
2857 & **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) &
2858 & *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) &
2859 & + 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 &
2860 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2861 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2862 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2863 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2864 & + y(3) + y(4))**2)
2865 beta_coef_z(i + 1, 2, &
2866 & 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) &
2867 & **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) &
2868 & *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) &
2869 & *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) &
2870 & *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) &
2871 & **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) &
2872 & **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) &
2873 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2874 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2875 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2876 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2877 & **2)
2878 beta_coef_z(i + 1, 2, &
2879 & 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 &
2880 & - 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)) &
2881 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2882
2883 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2884 beta_coef_z(i + 1, 1, &
2885 & 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 &
2886 & - 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)) &
2887 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2888 beta_coef_z(i + 1, 1, &
2889 & 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) &
2890 & *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) &
2891 & **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) &
2892 & **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) &
2893 & **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) &
2894 & **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) &
2895 & **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) &
2896 & *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) &
2897 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2898 & **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) &
2899 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2900 & + y(3) + y(4))**2)
2901 beta_coef_z(i + 1, 1, &
2902 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2903 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2904 & + 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) &
2905 & *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)) &
2906 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2907 & + y(4))**2)
2908 beta_coef_z(i + 1, 1, &
2909 & 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) &
2910 & + 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) &
2911 & **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) &
2912 & **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) &
2913 & **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) &
2914 & **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) &
2915 & + 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) &
2916 & **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) &
2917 & **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) &
2918 & **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) &
2919 & **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) &
2920 & - 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) &
2921 & **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) &
2922 & **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) &
2923 & *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) &
2924 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2925 & **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) &
2926 & **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) &
2927 & **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) &
2928 & **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) &
2929 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2930 beta_coef_z(i + 1, 1, &
2931 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2932 & **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) &
2933 & **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) &
2934 & *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) &
2935 & + 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) &
2936 & **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) &
2937 & **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) &
2938 & **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) &
2939 & **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 &
2940 & - 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 &
2941 & - 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) &
2942 & **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) &
2943 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2944 beta_coef_z(i + 1, 1, &
2945 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2946 & **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 &
2947 & + 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) &
2948 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2949 & + y(3) + y(4))**2)
2950
2951 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2952 beta_coef_z(i + 1, 0, &
2953 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2954 & **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 &
2955 & + 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) &
2956 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2957 & + y(3) + y(4))**2)
2958 beta_coef_z(i + 1, 0, &
2959 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2960 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2961 & **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) &
2962 & **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) &
2963 & + 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) &
2964 & **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 &
2965 & + 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) &
2966 & **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) &
2967 & *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 &
2968 & + 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) &
2969 & + 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) &
2970 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2971 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2972 beta_coef_z(i + 1, 0, &
2973 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2974 & *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) &
2975 & + 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) &
2976 & **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) &
2977 & + 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) &
2978 & *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) &
2979 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2980 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2981 beta_coef_z(i + 1, 0, &
2982 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2983 & **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) &
2984 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2985 & + 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) &
2986 & + 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) &
2987 & *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) &
2988 & *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) &
2989 & + 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) &
2990 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2991 & + 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) &
2992 & **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) &
2993 & **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) &
2994 & *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) &
2995 & **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) &
2996 & **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 &
2997 & + 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) &
2998 & + 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 &
2999 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
3000 & + 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) &
3001 & **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) &
3002 & **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) &
3003 & **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)) &
3004 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3005 beta_coef_z(i + 1, 0, &
3006 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
3007 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
3008 & **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) &
3009 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
3010 & **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) &
3011 & **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) &
3012 & **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) &
3013 & + 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) &
3014 & + 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) &
3015 & + 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) &
3016 & *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 &
3017 & + 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) &
3018 & *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) &
3019 & + 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) &
3020 & **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)) &
3021 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
3022 & + y(4))**2)
3023 beta_coef_z(i + 1, 0, &
3024 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
3025 & **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) &
3026 & + 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) &
3027 & *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 &
3028 & + 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) &
3029 & **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) &
3030 & + 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) &
3031 & **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) &
3032 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3033 & + y(3) + y(4))**2)
3034 end do
3035 else
3036 ! (Fu, et al., 2016) Table 2 (for right flux)
3037 d_cbl_z(0,:) = 18._wp/35._wp
3038 d_cbl_z(1,:) = 3._wp/35._wp
3039 d_cbl_z(2,:) = 9._wp/35._wp
3040 d_cbl_z(3,:) = 1._wp/35._wp
3041 d_cbl_z(4,:) = 4._wp/35._wp
3042
3043 d_cbr_z(0,:) = 18._wp/35._wp
3044 d_cbr_z(1,:) = 9._wp/35._wp
3045 d_cbr_z(2,:) = 3._wp/35._wp
3046 d_cbr_z(3,:) = 4._wp/35._wp
3047 d_cbr_z(4,:) = 1._wp/35._wp
3048 end if
3049 end if
3050 end if
3051# 841 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3052
3053 ! Detect whether grid spacing is uniform (enables cancellation-free sum-of-squares beta). Tolerance uses sqrt(epsilon) so it
3054 ! works in both double and single precision: ~1.5e-8 relative in double, ~3.5e-4 in single - above FP noise, below real
3055 ! stretching.
3056 uniform_grid(weno_dir) = .true.
3057 h0 = (s_cb(s) - s_cb(0))/real(s, wp)
3058 do i = 0, s - 1
3059 if (abs((s_cb(i + 1) - s_cb(i)) - h0) > sqrt(epsilon(h0))*abs(h0)) then
3060 uniform_grid(weno_dir) = .false.
3061 exit
3062 end if
3063 end do
3064
3065 if (weno_dir == 1) then
3066
3067# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3068#if defined(MFC_OpenACC)
3069# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3070!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3071# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3072#elif defined(MFC_OpenMP)
3073# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3074!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x, uniform_grid)
3075# 855 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3076#endif
3077 else if (weno_dir == 2) then
3078
3079# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3080#if defined(MFC_OpenACC)
3081# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3082!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3083# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3084#elif defined(MFC_OpenMP)
3085# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3086!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y, uniform_grid)
3087# 857 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3088#endif
3089 else
3090
3091# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3092#if defined(MFC_OpenACC)
3093# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3094!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3095# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3096#elif defined(MFC_OpenMP)
3097# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3098!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z, uniform_grid)
3099# 859 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3100#endif
3101 end if
3102
3103 ! Nullifying WENO coefficients and cell-boundary locations pointers
3104
3105 nullify (s_cb)
3106
3107 end subroutine s_compute_weno_coefficients
3108
3109 subroutine s_pack_weno_input_arr(v_vf)
3110
3111 type(scalar_field), dimension(1:), intent(in) :: v_vf
3112 integer :: i, j, k, l, n_vars
3113
3114
3115# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3116
3117# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3118#if defined(MFC_OpenACC)
3119# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3120!$acc parallel loop collapse(4) gang vector default(present)
3121# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3122#elif defined(MFC_OpenMP)
3123# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3124
3125# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3126
3127# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3128
3129# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3130!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3131# 873 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3132#endif
3133 do i = 1, v_size
3134 do l = idwbuff(3)%beg, idwbuff(3)%end
3135 do k = idwbuff(2)%beg, idwbuff(2)%end
3136 do j = idwbuff(1)%beg, idwbuff(1)%end
3137 v_rs_weno(j, k, l, i) = v_vf(i)%sf(j, k, l)
3138 end do
3139 end do
3140 end do
3141 end do
3142
3143# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3144#if defined(MFC_OpenACC)
3145# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3146!$acc end parallel loop
3147# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3148#elif defined(MFC_OpenMP)
3149# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3150
3151# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3152!$omp end target teams loop
3153# 883 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3154#endif
3155
3156 end subroutine s_pack_weno_input_arr
3157
3158 !> Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables
3159 subroutine s_weno(v_vf, vL_rs_vf_x, vR_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
3160
3161 type(scalar_field), dimension(1:), intent(in) :: v_vf
3162 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x
3163 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vr_rs_vf_x
3164 integer, intent(in) :: weno_dir
3165 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
3166
3167# 904 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3168 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
3169 real(wp), dimension(0:weno_num_stencils) :: poly
3170 real(wp), dimension(0:weno_num_stencils) :: alpha
3171 real(wp), dimension(0:weno_num_stencils) :: omega
3172 real(wp), dimension(0:weno_num_stencils) :: beta
3173 real(wp), dimension(0:weno_num_stencils) :: delta
3174# 911 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3175 real(wp), dimension(-3:3) :: v !< temporary field value array for clarity (WENO7 only)
3176 real(wp) :: tau
3177 integer :: i, j, k, l, q
3178 real(wp) :: vp0, vp1, vp2, vp3, vm1, vm2, vm3
3179
3180 is1_weno = is1_weno_d
3181 is2_weno = is2_weno_d
3182 is3_weno = is3_weno_d
3183
3184
3185# 920 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3186#if defined(MFC_OpenACC)
3187# 920 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3188!$acc update device(is1_weno, is2_weno, is3_weno)
3189# 920 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3190#elif defined(MFC_OpenMP)
3191# 920 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3192!$omp target update to(is1_weno, is2_weno, is3_weno)
3193# 920 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3194#endif
3195
3196 v_size = ubound(v_vf, 1)
3197
3198# 923 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199#if defined(MFC_OpenACC)
3200# 923 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201!$acc update device(v_size)
3202# 923 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203#elif defined(MFC_OpenMP)
3204# 923 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3205!$omp target update to(v_size)
3206# 923 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3207#endif
3208
3209 if (weno_order == 1) then
3210 if (weno_dir == 1) then
3211
3212# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3213
3214# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3215#if defined(MFC_OpenACC)
3216# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3217!$acc parallel loop collapse(4) gang vector default(present)
3218# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3219#elif defined(MFC_OpenMP)
3220# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3221
3222# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3223
3224# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3225
3226# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3227!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3228# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3229#endif
3230 do i = 1, v_size
3231 do l = is3_weno%beg, is3_weno%end
3232 do k = is2_weno%beg, is2_weno%end
3233 do j = is1_weno%beg, is1_weno%end
3234 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3235 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3236 end do
3237 end do
3238 end do
3239 end do
3240
3241# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3242#if defined(MFC_OpenACC)
3243# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3244!$acc end parallel loop
3245# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3246#elif defined(MFC_OpenMP)
3247# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3248
3249# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3250!$omp end target teams loop
3251# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3252#endif
3253 else if (weno_dir == 2) then
3254
3255# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3256
3257# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3258#if defined(MFC_OpenACC)
3259# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3260!$acc parallel loop collapse(4) gang vector default(present)
3261# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3262#elif defined(MFC_OpenMP)
3263# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3264
3265# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3266
3267# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3268
3269# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3270!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3271# 940 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3272#endif
3273 do i = 1, v_size
3274 do l = is3_weno%beg, is3_weno%end
3275 do j = is1_weno%beg, is1_weno%end
3276 do k = is2_weno%beg, is2_weno%end
3277 vl_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3278 vr_rs_vf_x(k, j, l, i) = v_vf(i)%sf(k, j, l)
3279 end do
3280 end do
3281 end do
3282 end do
3283
3284# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3285#if defined(MFC_OpenACC)
3286# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3287!$acc end parallel loop
3288# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3289#elif defined(MFC_OpenMP)
3290# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3291
3292# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3293!$omp end target teams loop
3294# 951 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3295#endif
3296 else if (weno_dir == 3) then
3297
3298# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3299
3300# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3301#if defined(MFC_OpenACC)
3302# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3303!$acc parallel loop collapse(4) gang vector default(present)
3304# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3305#elif defined(MFC_OpenMP)
3306# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3307
3308# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3309
3310# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3311
3312# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3313!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3314# 953 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3315#endif
3316 do i = 1, v_size
3317 do j = is1_weno%beg, is1_weno%end
3318 do k = is2_weno%beg, is2_weno%end
3319 do l = is3_weno%beg, is3_weno%end
3320 vl_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3321 vr_rs_vf_x(l, k, j, i) = v_vf(i)%sf(l, k, j)
3322 end do
3323 end do
3324 end do
3325 end do
3326
3327# 964 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3328#if defined(MFC_OpenACC)
3329# 964 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3330!$acc end parallel loop
3331# 964 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3332#elif defined(MFC_OpenMP)
3333# 964 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3334
3335# 964 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3336!$omp end target teams loop
3337# 964 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3338#endif
3339 end if
3340 end if
3341
3342 if (weno_order /= 1) then
3343 call s_pack_weno_input_arr(v_vf)
3344 end if
3345
3346 if (weno_order == 3) then
3347# 977 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3348# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3349# 979 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3350 if (weno_dir == 1) then
3351
3352# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3353
3354# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3355#if defined(MFC_OpenACC)
3356# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3357!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3358# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3359#elif defined(MFC_OpenMP)
3360# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3361
3362# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3363
3364# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3365
3366# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3367!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3368# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3369!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3370# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3371#endif
3372 do l = is3_weno%beg, is3_weno%end
3373 do k = is2_weno%beg, is2_weno%end
3374 do j = is1_weno%beg, is1_weno%end
3375 do i = 1, v_size
3376 ! reconstruct from left side
3377
3378 alpha(:) = 0._wp
3379
3380 vp0 = v_rs_weno(j, k, l, i)
3381 vm1 = v_rs_weno(j - 1, k, l, i)
3382 vp1 = v_rs_weno(j + 1, k, l, i)
3383
3384 dvd(0) = vp1 - vp0
3385 dvd(-1) = vp0 - vm1
3386
3387 poly(0) = vp0 + poly_coef_cbl_x(j, 0, 0)*dvd(0)
3388 poly(1) = vp0 + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
3389
3390 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3391 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3392
3393 if (wenojs) then
3394 do q = 0, weno_num_stencils
3395 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3396 end do
3397 else if (mapped_weno) then
3398 do q = 0, weno_num_stencils
3399 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3400 end do
3401 omega = alpha/sum(alpha)
3402 do q = 0, weno_num_stencils
3403 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3404 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3405 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3406 end do
3407 else if (wenoz) then
3408 ! Borges, et al. (2008)
3409 tau = abs(beta(1) - beta(0))
3410 do q = 0, weno_num_stencils
3411 alpha(q) = d_cbl_x(q, j)*(1._wp + tau/beta(q))
3412 end do
3413 end if
3414 omega = alpha/sum(alpha)
3415
3416 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3417
3418 ! reconstruct from right side
3419
3420 poly(0) = vp0 + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3421 poly(1) = vp0 + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3422
3423 if (wenojs) then
3424 do q = 0, weno_num_stencils
3425 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3426 end do
3427 else if (mapped_weno) then
3428 do q = 0, weno_num_stencils
3429 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3430 end do
3431 omega = alpha/sum(alpha)
3432 do q = 0, weno_num_stencils
3433 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3434 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3435 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3436 end do
3437 else if (wenoz) then
3438 do q = 0, weno_num_stencils
3439 alpha(q) = d_cbr_x(q, j)*(1._wp + tau/beta(q))
3440 end do
3441 end if
3442 omega = alpha/sum(alpha)
3443
3444 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3445 end do
3446 end do
3447 end do
3448 end do
3449
3450# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3451#if defined(MFC_OpenACC)
3452# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3453!$acc end parallel loop
3454# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3455#elif defined(MFC_OpenMP)
3456# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3457
3458# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3459!$omp end target teams loop
3460# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3461#endif
3462 end if
3463# 977 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3464# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3465# 979 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3466 if (weno_dir == 2) then
3467
3468# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3469
3470# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3471#if defined(MFC_OpenACC)
3472# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3473!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3474# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3475#elif defined(MFC_OpenMP)
3476# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3477
3478# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3479
3480# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3481
3482# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3483!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3484# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3485!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3486# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3487#endif
3488 do l = is3_weno%beg, is3_weno%end
3489 do k = is1_weno%beg, is1_weno%end
3490 do j = is2_weno%beg, is2_weno%end
3491 do i = 1, v_size
3492 ! reconstruct from left side
3493
3494 alpha(:) = 0._wp
3495
3496 vp0 = v_rs_weno(j, k, l, i)
3497 vm1 = v_rs_weno(j, k - 1, l, i)
3498 vp1 = v_rs_weno(j, k + 1, l, i)
3499
3500 dvd(0) = vp1 - vp0
3501 dvd(-1) = vp0 - vm1
3502
3503 poly(0) = vp0 + poly_coef_cbl_y(k, 0, 0)*dvd(0)
3504 poly(1) = vp0 + poly_coef_cbl_y(k, 1, 0)*dvd(-1)
3505
3506 beta(0) = beta_coef_y(k, 0, 0)*dvd(0)*dvd(0) + weno_eps
3507 beta(1) = beta_coef_y(k, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3508
3509 if (wenojs) then
3510 do q = 0, weno_num_stencils
3511 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3512 end do
3513 else if (mapped_weno) then
3514 do q = 0, weno_num_stencils
3515 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
3516 end do
3517 omega = alpha/sum(alpha)
3518 do q = 0, weno_num_stencils
3519 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
3520 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3521 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
3522 end do
3523 else if (wenoz) then
3524 ! Borges, et al. (2008)
3525 tau = abs(beta(1) - beta(0))
3526 do q = 0, weno_num_stencils
3527 alpha(q) = d_cbl_y(q, k)*(1._wp + tau/beta(q))
3528 end do
3529 end if
3530 omega = alpha/sum(alpha)
3531
3532 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3533
3534 ! reconstruct from right side
3535
3536 poly(0) = vp0 + poly_coef_cbr_y(k, 0, 0)*dvd(0)
3537 poly(1) = vp0 + poly_coef_cbr_y(k, 1, 0)*dvd(-1)
3538
3539 if (wenojs) then
3540 do q = 0, weno_num_stencils
3541 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3542 end do
3543 else if (mapped_weno) then
3544 do q = 0, weno_num_stencils
3545 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
3546 end do
3547 omega = alpha/sum(alpha)
3548 do q = 0, weno_num_stencils
3549 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
3550 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
3551 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
3552 end do
3553 else if (wenoz) then
3554 do q = 0, weno_num_stencils
3555 alpha(q) = d_cbr_y(q, k)*(1._wp + tau/beta(q))
3556 end do
3557 end if
3558 omega = alpha/sum(alpha)
3559
3560 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3561 end do
3562 end do
3563 end do
3564 end do
3565
3566# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3567#if defined(MFC_OpenACC)
3568# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3569!$acc end parallel loop
3570# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3571#elif defined(MFC_OpenMP)
3572# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3573
3574# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3575!$omp end target teams loop
3576# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3577#endif
3578 end if
3579# 977 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3580# 978 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3581# 979 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3582 if (weno_dir == 3) then
3583
3584# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3585
3586# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3587#if defined(MFC_OpenACC)
3588# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3589!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3590# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3591#elif defined(MFC_OpenMP)
3592# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3593
3594# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3595
3596# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3597
3598# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3599!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3600# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3601!$omp& private(beta, dvd, poly, omega, alpha, tau, q, vp0, vp1, vm1)
3602# 980 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3603#endif
3604 do l = is1_weno%beg, is1_weno%end
3605 do k = is2_weno%beg, is2_weno%end
3606 do j = is3_weno%beg, is3_weno%end
3607 do i = 1, v_size
3608 ! reconstruct from left side
3609
3610 alpha(:) = 0._wp
3611
3612 vp0 = v_rs_weno(j, k, l, i)
3613 vm1 = v_rs_weno(j, k, l - 1, i)
3614 vp1 = v_rs_weno(j, k, l + 1, i)
3615
3616 dvd(0) = vp1 - vp0
3617 dvd(-1) = vp0 - vm1
3618
3619 poly(0) = vp0 + poly_coef_cbl_z(l, 0, 0)*dvd(0)
3620 poly(1) = vp0 + poly_coef_cbl_z(l, 1, 0)*dvd(-1)
3621
3622 beta(0) = beta_coef_z(l, 0, 0)*dvd(0)*dvd(0) + weno_eps
3623 beta(1) = beta_coef_z(l, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3624
3625 if (wenojs) then
3626 do q = 0, weno_num_stencils
3627 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3628 end do
3629 else if (mapped_weno) then
3630 do q = 0, weno_num_stencils
3631 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
3632 end do
3633 omega = alpha/sum(alpha)
3634 do q = 0, weno_num_stencils
3635 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
3636 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
3637 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
3638 end do
3639 else if (wenoz) then
3640 ! Borges, et al. (2008)
3641 tau = abs(beta(1) - beta(0))
3642 do q = 0, weno_num_stencils
3643 alpha(q) = d_cbl_z(q, l)*(1._wp + tau/beta(q))
3644 end do
3645 end if
3646 omega = alpha/sum(alpha)
3647
3648 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3649
3650 ! reconstruct from right side
3651
3652 poly(0) = vp0 + poly_coef_cbr_z(l, 0, 0)*dvd(0)
3653 poly(1) = vp0 + poly_coef_cbr_z(l, 1, 0)*dvd(-1)
3654
3655 if (wenojs) then
3656 do q = 0, weno_num_stencils
3657 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3658 end do
3659 else if (mapped_weno) then
3660 do q = 0, weno_num_stencils
3661 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
3662 end do
3663 omega = alpha/sum(alpha)
3664 do q = 0, weno_num_stencils
3665 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
3666 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
3667 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
3668 end do
3669 else if (wenoz) then
3670 do q = 0, weno_num_stencils
3671 alpha(q) = d_cbr_z(q, l)*(1._wp + tau/beta(q))
3672 end do
3673 end if
3674 omega = alpha/sum(alpha)
3675
3676 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3677 end do
3678 end do
3679 end do
3680 end do
3681
3682# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3683#if defined(MFC_OpenACC)
3684# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3685!$acc end parallel loop
3686# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3687#elif defined(MFC_OpenMP)
3688# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3689
3690# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3691!$omp end target teams loop
3692# 1058 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3693#endif
3694 end if
3695# 1061 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3696 end if
3697 if (weno_order == 5) then
3698# 1064 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3699# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3700# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3701# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3702 if (weno_dir == 1) then
3703
3704# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3705
3706# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3707#if defined(MFC_OpenACC)
3708# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3709!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3710# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3711#elif defined(MFC_OpenMP)
3712# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3713
3714# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3715
3716# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3717
3718# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3719!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3720# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3721!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3722# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3723#endif
3724# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3725 do l = is3_weno%beg, is3_weno%end
3726 do k = is2_weno%beg, is2_weno%end
3727 do j = is1_weno%beg, is1_weno%end
3728
3729# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3730#if defined(MFC_OpenACC)
3731# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3732!$acc loop seq
3733# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3734#elif defined(MFC_OpenMP)
3735# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3736
3737# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3738#endif
3739 do i = 1, v_size
3740 ! reconstruct from left side
3741
3742 alpha(:) = 0._wp
3743
3744 vp0 = v_rs_weno(j, k, l, i)
3745 vm1 = v_rs_weno(j - 1, k, l, i)
3746 vm2 = v_rs_weno(j - 2, k, l, i)
3747 vp1 = v_rs_weno(j + 1, k, l, i)
3748 vp2 = v_rs_weno(j + 2, k, l, i)
3749
3750 dvd(1) = vp2 - vp1
3751 dvd(0) = vp1 - vp0
3752 dvd(-1) = vp0 - vm1
3753 dvd(-2) = vm1 - vm2
3754
3755 poly(0) = vp0 + poly_coef_cbl_x(j, 0, &
3756 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3757 poly(1) = vp0 + poly_coef_cbl_x(j, 1, &
3758 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3759 poly(2) = vp0 + poly_coef_cbl_x(j, 2, &
3760 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3761
3762 if (uniform_grid(1)) then
3763 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
3764 & + weno_eps
3765 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
3766 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
3767 & + weno_eps
3768 else
3769 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
3770 & 0, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3771 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
3772 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, &
3773 & 2)*dvd(-1)*dvd(-1) + weno_eps
3774 beta(2) = beta_coef_x(j, 2, &
3775 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3776 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3777 end if
3778
3779 if (wenojs) then
3780 do q = 0, weno_num_stencils
3781 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3782 end do
3783 else if (mapped_weno) then
3784 do q = 0, weno_num_stencils
3785 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3786 end do
3787 omega = alpha/sum(alpha)
3788 do q = 0, weno_num_stencils
3789 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3790 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3791 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3792 end do
3793 else if (wenoz) then
3794 ! Borges, et al. (2008)
3795
3796 tau = abs(beta(2) - beta(0)) ! Equation 25
3797
3798# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3799#if defined(MFC_OpenACC)
3800# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3801!$acc loop seq
3802# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3803#elif defined(MFC_OpenMP)
3804# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3805
3806# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3807#endif
3808 do q = 0, weno_num_stencils
3809 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3810 ! Equation 28 (note: weno_eps was already added to beta)
3811 end do
3812 else if (teno) then
3813 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3814 tau = abs(beta(2) - beta(0))
3815
3816# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3817#if defined(MFC_OpenACC)
3818# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3819!$acc loop seq
3820# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3821#elif defined(MFC_OpenMP)
3822# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3823
3824# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3825#endif
3826 do q = 0, weno_num_stencils
3827 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3828 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3829 alpha(q) = (alpha(q)**3._wp)**2._wp
3830 end do
3831 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3832
3833
3834# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3835#if defined(MFC_OpenACC)
3836# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3837!$acc loop seq
3838# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3839#elif defined(MFC_OpenMP)
3840# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3841
3842# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3843#endif
3844 do q = 0, weno_num_stencils
3845 if (omega(q) < teno_ct) then ! Equation 26
3846 delta(q) = 0._wp
3847 else
3848 delta(q) = 1._wp
3849 end if
3850 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3851 end do
3852 end if
3853
3854 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3855 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3856 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3857
3858 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3859
3860 ! reconstruct from right side
3861
3862 poly(0) = vp0 + poly_coef_cbr_x(j, 0, &
3863 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3864 poly(1) = vp0 + poly_coef_cbr_x(j, 1, &
3865 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3866 poly(2) = vp0 + poly_coef_cbr_x(j, 2, &
3867 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3868
3869 if (wenojs) then
3870 do q = 0, weno_num_stencils
3871 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3872 end do
3873 else if (mapped_weno) then
3874 do q = 0, weno_num_stencils
3875 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3876 end do
3877 omega = alpha/sum(alpha)
3878 do q = 0, weno_num_stencils
3879 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3880 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3881 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3882 end do
3883 else if (wenoz) then
3884
3885# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3886#if defined(MFC_OpenACC)
3887# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3888!$acc loop seq
3889# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3890#elif defined(MFC_OpenMP)
3891# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3892
3893# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3894#endif
3895 do q = 0, weno_num_stencils
3896 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3897 end do
3898 else if (teno) then
3899
3900# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3901#if defined(MFC_OpenACC)
3902# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3903!$acc loop seq
3904# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3905#elif defined(MFC_OpenMP)
3906# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3907
3908# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3909#endif
3910 do q = 0, weno_num_stencils
3911 alpha(q) = delta(q)*d_cbr_x(q, j)
3912 end do
3913 end if
3914
3915 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3916 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3917 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3918
3919 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3920 end do
3921 end do
3922 end do
3923 end do
3924
3925# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3926#if defined(MFC_OpenACC)
3927# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3928!$acc end parallel loop
3929# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3930#elif defined(MFC_OpenMP)
3931# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3932
3933# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3934!$omp end target teams loop
3935# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3936#endif
3937
3938 if (mp_weno) then
3939 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
3940 end if
3941 end if
3942# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3943# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3944# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3945 if (weno_dir == 2) then
3946
3947# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3948
3949# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3950#if defined(MFC_OpenACC)
3951# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3952!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3953# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3954#elif defined(MFC_OpenMP)
3955# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3956
3957# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3958
3959# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3960
3961# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3962!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
3963# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3964!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
3965# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3966#endif
3967# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3968 do l = is3_weno%beg, is3_weno%end
3969 do k = is1_weno%beg, is1_weno%end
3970 do j = is2_weno%beg, is2_weno%end
3971
3972# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3973#if defined(MFC_OpenACC)
3974# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3975!$acc loop seq
3976# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3977#elif defined(MFC_OpenMP)
3978# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3979
3980# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3981#endif
3982 do i = 1, v_size
3983 ! reconstruct from left side
3984
3985 alpha(:) = 0._wp
3986
3987 vp0 = v_rs_weno(j, k, l, i)
3988 vm1 = v_rs_weno(j, k - 1, l, i)
3989 vm2 = v_rs_weno(j, k - 2, l, i)
3990 vp1 = v_rs_weno(j, k + 1, l, i)
3991 vp2 = v_rs_weno(j, k + 2, l, i)
3992
3993 dvd(1) = vp2 - vp1
3994 dvd(0) = vp1 - vp0
3995 dvd(-1) = vp0 - vm1
3996 dvd(-2) = vm1 - vm2
3997
3998 poly(0) = vp0 + poly_coef_cbl_y(k, 0, &
3999 & 0)*dvd(1) + poly_coef_cbl_y(k, 0, 1)*dvd(0)
4000 poly(1) = vp0 + poly_coef_cbl_y(k, 1, &
4001 & 0)*dvd(0) + poly_coef_cbl_y(k, 1, 1)*dvd(-1)
4002 poly(2) = vp0 + poly_coef_cbl_y(k, 2, &
4003 & 0)*dvd(-1) + poly_coef_cbl_y(k, 2, 1)*dvd(-2)
4004
4005 if (uniform_grid(2)) then
4006 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4007 & + weno_eps
4008 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4009 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4010 & + weno_eps
4011 else
4012 beta(0) = beta_coef_y(k, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4013 & 0, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 2)*dvd(0)*dvd(0) + weno_eps
4014 beta(1) = beta_coef_y(k, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4015 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, &
4016 & 2)*dvd(-1)*dvd(-1) + weno_eps
4017 beta(2) = beta_coef_y(k, 2, &
4018 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4019 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4020 end if
4021
4022 if (wenojs) then
4023 do q = 0, weno_num_stencils
4024 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4025 end do
4026 else if (mapped_weno) then
4027 do q = 0, weno_num_stencils
4028 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4029 end do
4030 omega = alpha/sum(alpha)
4031 do q = 0, weno_num_stencils
4032 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4033 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4034 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4035 end do
4036 else if (wenoz) then
4037 ! Borges, et al. (2008)
4038
4039 tau = abs(beta(2) - beta(0)) ! Equation 25
4040
4041# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4042#if defined(MFC_OpenACC)
4043# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4044!$acc loop seq
4045# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4046#elif defined(MFC_OpenMP)
4047# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4048
4049# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4050#endif
4051 do q = 0, weno_num_stencils
4052 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q)))
4053 ! Equation 28 (note: weno_eps was already added to beta)
4054 end do
4055 else if (teno) then
4056 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4057 tau = abs(beta(2) - beta(0))
4058
4059# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4060#if defined(MFC_OpenACC)
4061# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4062!$acc loop seq
4063# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4064#elif defined(MFC_OpenMP)
4065# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4066
4067# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4068#endif
4069 do q = 0, weno_num_stencils
4070 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4071 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4072 alpha(q) = (alpha(q)**3._wp)**2._wp
4073 end do
4074 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4075
4076
4077# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4078#if defined(MFC_OpenACC)
4079# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4080!$acc loop seq
4081# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4082#elif defined(MFC_OpenMP)
4083# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4084
4085# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4086#endif
4087 do q = 0, weno_num_stencils
4088 if (omega(q) < teno_ct) then ! Equation 26
4089 delta(q) = 0._wp
4090 else
4091 delta(q) = 1._wp
4092 end if
4093 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4094 end do
4095 end if
4096
4097 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4098 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4099 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4100
4101 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4102
4103 ! reconstruct from right side
4104
4105 poly(0) = vp0 + poly_coef_cbr_y(k, 0, &
4106 & 0)*dvd(1) + poly_coef_cbr_y(k, 0, 1)*dvd(0)
4107 poly(1) = vp0 + poly_coef_cbr_y(k, 1, &
4108 & 0)*dvd(0) + poly_coef_cbr_y(k, 1, 1)*dvd(-1)
4109 poly(2) = vp0 + poly_coef_cbr_y(k, 2, &
4110 & 0)*dvd(-1) + poly_coef_cbr_y(k, 2, 1)*dvd(-2)
4111
4112 if (wenojs) then
4113 do q = 0, weno_num_stencils
4114 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4115 end do
4116 else if (mapped_weno) then
4117 do q = 0, weno_num_stencils
4118 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4119 end do
4120 omega = alpha/sum(alpha)
4121 do q = 0, weno_num_stencils
4122 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4123 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4124 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4125 end do
4126 else if (wenoz) then
4127
4128# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4129#if defined(MFC_OpenACC)
4130# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4131!$acc loop seq
4132# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4133#elif defined(MFC_OpenMP)
4134# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4135
4136# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4137#endif
4138 do q = 0, weno_num_stencils
4139 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q)))
4140 end do
4141 else if (teno) then
4142
4143# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4144#if defined(MFC_OpenACC)
4145# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4146!$acc loop seq
4147# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4148#elif defined(MFC_OpenMP)
4149# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4150
4151# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4152#endif
4153 do q = 0, weno_num_stencils
4154 alpha(q) = delta(q)*d_cbr_y(q, k)
4155 end do
4156 end if
4157
4158 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4159 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4160 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4161
4162 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4163 end do
4164 end do
4165 end do
4166 end do
4167
4168# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4169#if defined(MFC_OpenACC)
4170# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4171!$acc end parallel loop
4172# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4173#elif defined(MFC_OpenMP)
4174# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4175
4176# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4177!$omp end target teams loop
4178# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4179#endif
4180
4181 if (mp_weno) then
4182 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4183 end if
4184 end if
4185# 1068 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4186# 1069 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4187# 1070 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4188 if (weno_dir == 3) then
4189
4190# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4191
4192# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4193#if defined(MFC_OpenACC)
4194# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4195!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4196# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4197#elif defined(MFC_OpenMP)
4198# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4199
4200# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4201
4202# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4203
4204# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4205!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4206# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4207!$omp& private(dvd, poly, beta, alpha, omega, tau, delta, q, vp0, vm1, vm2, vp1, vp2)
4208# 1071 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4209#endif
4210# 1073 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4211 do l = is1_weno%beg, is1_weno%end
4212 do k = is2_weno%beg, is2_weno%end
4213 do j = is3_weno%beg, is3_weno%end
4214
4215# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4216#if defined(MFC_OpenACC)
4217# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4218!$acc loop seq
4219# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4220#elif defined(MFC_OpenMP)
4221# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4222
4223# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4224#endif
4225 do i = 1, v_size
4226 ! reconstruct from left side
4227
4228 alpha(:) = 0._wp
4229
4230 vp0 = v_rs_weno(j, k, l, i)
4231 vm1 = v_rs_weno(j, k, l - 1, i)
4232 vm2 = v_rs_weno(j, k, l - 2, i)
4233 vp1 = v_rs_weno(j, k, l + 1, i)
4234 vp2 = v_rs_weno(j, k, l + 2, i)
4235
4236 dvd(1) = vp2 - vp1
4237 dvd(0) = vp1 - vp0
4238 dvd(-1) = vp0 - vm1
4239 dvd(-2) = vm1 - vm2
4240
4241 poly(0) = vp0 + poly_coef_cbl_z(l, 0, &
4242 & 0)*dvd(1) + poly_coef_cbl_z(l, 0, 1)*dvd(0)
4243 poly(1) = vp0 + poly_coef_cbl_z(l, 1, &
4244 & 0)*dvd(0) + poly_coef_cbl_z(l, 1, 1)*dvd(-1)
4245 poly(2) = vp0 + poly_coef_cbl_z(l, 2, &
4246 & 0)*dvd(-1) + poly_coef_cbl_z(l, 2, 1)*dvd(-2)
4247
4248 if (uniform_grid(3)) then
4249 beta(0) = 13._wp/12._wp*(dvd(1) - dvd(0))**2 + 0.25_wp*(dvd(1) - 3._wp*dvd(0))**2 &
4250 & + weno_eps
4251 beta(1) = 13._wp/12._wp*(dvd(0) - dvd(-1))**2 + 0.25_wp*(dvd(0) + dvd(-1))**2 + weno_eps
4252 beta(2) = 13._wp/12._wp*(dvd(-1) - dvd(-2))**2 + 0.25_wp*(3._wp*dvd(-1) - dvd(-2))**2 &
4253 & + weno_eps
4254 else
4255 beta(0) = beta_coef_z(l, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
4256 & 0, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 2)*dvd(0)*dvd(0) + weno_eps
4257 beta(1) = beta_coef_z(l, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
4258 & 1, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, &
4259 & 2)*dvd(-1)*dvd(-1) + weno_eps
4260 beta(2) = beta_coef_z(l, 2, &
4261 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
4262 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4263 end if
4264
4265 if (wenojs) then
4266 do q = 0, weno_num_stencils
4267 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4268 end do
4269 else if (mapped_weno) then
4270 do q = 0, weno_num_stencils
4271 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
4272 end do
4273 omega = alpha/sum(alpha)
4274 do q = 0, weno_num_stencils
4275 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
4276 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
4277 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
4278 end do
4279 else if (wenoz) then
4280 ! Borges, et al. (2008)
4281
4282 tau = abs(beta(2) - beta(0)) ! Equation 25
4283
4284# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4285#if defined(MFC_OpenACC)
4286# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4287!$acc loop seq
4288# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4289#elif defined(MFC_OpenMP)
4290# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4291
4292# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4293#endif
4294 do q = 0, weno_num_stencils
4295 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q)))
4296 ! Equation 28 (note: weno_eps was already added to beta)
4297 end do
4298 else if (teno) then
4299 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4300 tau = abs(beta(2) - beta(0))
4301
4302# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4303#if defined(MFC_OpenACC)
4304# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4305!$acc loop seq
4306# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4307#elif defined(MFC_OpenMP)
4308# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4309
4310# 1143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4311#endif
4312 do q = 0, weno_num_stencils
4313 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4314 ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4315 alpha(q) = (alpha(q)**3._wp)**2._wp
4316 end do
4317 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4318
4319
4320# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4321#if defined(MFC_OpenACC)
4322# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4323!$acc loop seq
4324# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4325#elif defined(MFC_OpenMP)
4326# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4327
4328# 1151 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4329#endif
4330 do q = 0, weno_num_stencils
4331 if (omega(q) < teno_ct) then ! Equation 26
4332 delta(q) = 0._wp
4333 else
4334 delta(q) = 1._wp
4335 end if
4336 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
4337 end do
4338 end if
4339
4340 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4341 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4342 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4343
4344 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4345
4346 ! reconstruct from right side
4347
4348 poly(0) = vp0 + poly_coef_cbr_z(l, 0, &
4349 & 0)*dvd(1) + poly_coef_cbr_z(l, 0, 1)*dvd(0)
4350 poly(1) = vp0 + poly_coef_cbr_z(l, 1, &
4351 & 0)*dvd(0) + poly_coef_cbr_z(l, 1, 1)*dvd(-1)
4352 poly(2) = vp0 + poly_coef_cbr_z(l, 2, &
4353 & 0)*dvd(-1) + poly_coef_cbr_z(l, 2, 1)*dvd(-2)
4354
4355 if (wenojs) then
4356 do q = 0, weno_num_stencils
4357 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4358 end do
4359 else if (mapped_weno) then
4360 do q = 0, weno_num_stencils
4361 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
4362 end do
4363 omega = alpha/sum(alpha)
4364 do q = 0, weno_num_stencils
4365 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
4366 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
4367 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
4368 end do
4369 else if (wenoz) then
4370
4371# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4372#if defined(MFC_OpenACC)
4373# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4374!$acc loop seq
4375# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4376#elif defined(MFC_OpenMP)
4377# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4378
4379# 1192 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4380#endif
4381 do q = 0, weno_num_stencils
4382 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q)))
4383 end do
4384 else if (teno) then
4385
4386# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4387#if defined(MFC_OpenACC)
4388# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4389!$acc loop seq
4390# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4391#elif defined(MFC_OpenMP)
4392# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4393
4394# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4395#endif
4396 do q = 0, weno_num_stencils
4397 alpha(q) = delta(q)*d_cbr_z(q, l)
4398 end do
4399 end if
4400
4401 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4402 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4403 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4404
4405 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4406 end do
4407 end do
4408 end do
4409 end do
4410
4411# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4412#if defined(MFC_OpenACC)
4413# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4414!$acc end parallel loop
4415# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4416#elif defined(MFC_OpenMP)
4417# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4418
4419# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4420!$omp end target teams loop
4421# 1212 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4422#endif
4423
4424 if (mp_weno) then
4425 call s_preserve_monotonicity(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir)
4426 end if
4427 end if
4428# 1219 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4429# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4430 end if
4431 if (weno_order == 7) then
4432# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4433# 1227 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4434# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4435# 1229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4436 if (weno_dir == 1) then
4437
4438# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4439
4440# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4441#if defined(MFC_OpenACC)
4442# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4443!$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)
4444# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4445#elif defined(MFC_OpenMP)
4446# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4447
4448# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4449
4450# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4451
4452# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4453!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4454# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4455!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4456# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4457#endif
4458# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4459 do l = is3_weno%beg, is3_weno%end
4460 do k = is2_weno%beg, is2_weno%end
4461 do j = is1_weno%beg, is1_weno%end
4462
4463# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4464#if defined(MFC_OpenACC)
4465# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4466!$acc loop seq
4467# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4468#elif defined(MFC_OpenMP)
4469# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4470
4471# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4472#endif
4473 do i = 1, v_size
4474 alpha(:) = 0._wp
4475
4476 vp0 = v_rs_weno(j, k, l, i)
4477 vm1 = v_rs_weno(j - 1, k, l, i)
4478 vm2 = v_rs_weno(j - 2, k, l, i)
4479 vm3 = v_rs_weno(j - 3, k, l, i)
4480 vp1 = v_rs_weno(j + 1, k, l, i)
4481 vp2 = v_rs_weno(j + 2, k, l, i)
4482 vp3 = v_rs_weno(j + 3, k, l, i)
4483
4484 if (teno) then
4485 v(-3) = vm3
4486 v(-2) = vm2
4487 v(-1) = vm1
4488 v(0) = vp0
4489 v(1) = vp1
4490 v(2) = vp2
4491 v(3) = vp3
4492 end if
4493
4494 if (.not. teno) then
4495 dvd(2) = vp3 - vp2
4496 dvd(1) = vp2 - vp1
4497 dvd(0) = vp1 - vp0
4498 dvd(-1) = vp0 - vm1
4499 dvd(-2) = vm1 - vm2
4500 dvd(-3) = vm2 - vm3
4501
4502 poly(3) = vp0 + poly_coef_cbl_x(j, 0, &
4503 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, &
4504 & 1)*dvd(1) + poly_coef_cbl_x(j, 0, 2)*dvd(0)
4505 poly(2) = vp0 + poly_coef_cbl_x(j, 1, &
4506 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, &
4507 & 1)*dvd(0) + poly_coef_cbl_x(j, 1, 2)*dvd(-1)
4508 poly(1) = vp0 + poly_coef_cbl_x(j, 2, &
4509 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4510 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4511 poly(0) = vp0 + poly_coef_cbl_x(j, 3, &
4512 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4513 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4514 else
4515# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4516 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4517 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4518 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4519 ! to keep the stencil order to reuse the beta coefficients
4520 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4521 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4522 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4523 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4524 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4525# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4526 end if
4527
4528 if (.not. teno) then
4529 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, &
4530 & 0, 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4531 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4532 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4533 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4534
4535 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, &
4536 & 1, 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4537 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4538 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4539 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4540
4541 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, &
4542 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4543 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4544 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4545 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4546
4547 beta(0) = beta_coef_x(j, 3, &
4548 & 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4549 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4550 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4551 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4552 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4553 else
4554# 1318 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4555 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4556 ! & Tang, 2019) Section 3.2
4557 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4558 & **2._wp)/4._wp + weno_eps
4559 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4560 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4561 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4562 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4563
4564 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4565 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4566 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4567
4568 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4569 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4570 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4571# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4572 end if
4573
4574 if (wenojs) then
4575 do q = 0, weno_num_stencils
4576 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4577 end do
4578 else if (mapped_weno) then
4579 do q = 0, weno_num_stencils
4580 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4581 end do
4582 omega = alpha/sum(alpha)
4583 do q = 0, weno_num_stencils
4584 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
4585 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
4586 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
4587 end do
4588 else if (wenoz) then
4589 ! Castro, et al. (2010) Don & Borges (2013) also helps
4590 tau = abs(beta(3) - beta(0)) ! Equation 50
4591
4592# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4593#if defined(MFC_OpenACC)
4594# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4595!$acc loop seq
4596# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4597#elif defined(MFC_OpenMP)
4598# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4599
4600# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4601#endif
4602 do q = 0, weno_num_stencils
4603 ! wenoz_q = 2,3,4 for stability
4604 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4605 end do
4606 else if (teno) then
4607# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4608 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4609 alpha = 1._wp + tau/beta
4610 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4611 omega = alpha/sum(alpha)
4612
4613
4614# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4615#if defined(MFC_OpenACC)
4616# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4617!$acc loop seq
4618# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4619#elif defined(MFC_OpenMP)
4620# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4621
4622# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4623#endif
4624 do q = 0, weno_num_stencils
4625 if (omega(q) < teno_ct) then ! Equation 26
4626 delta(q) = 0._wp
4627 else
4628 delta(q) = 1._wp
4629 end if
4630 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4631 end do
4632# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4633 end if
4634
4635 omega = alpha/sum(alpha)
4636
4637 vl_rs_vf_x(j, k, l, &
4638 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4639
4640 if (teno) then
4641# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4642 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4643# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4644 end if
4645
4646 if (.not. teno) then
4647 poly(3) = vp0 + poly_coef_cbr_x(j, 0, &
4648 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, &
4649 & 1)*dvd(1) + poly_coef_cbr_x(j, 0, 2)*dvd(0)
4650 poly(2) = vp0 + poly_coef_cbr_x(j, 1, &
4651 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, &
4652 & 1)*dvd(0) + poly_coef_cbr_x(j, 1, 2)*dvd(-1)
4653 poly(1) = vp0 + poly_coef_cbr_x(j, 2, &
4654 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4655 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4656 poly(0) = vp0 + poly_coef_cbr_x(j, 3, &
4657 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4658 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4659 else
4660# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4661 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4662 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4663 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4664 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4665 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4666# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4667 end if
4668
4669 if (wenojs) then
4670 do q = 0, weno_num_stencils
4671 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4672 end do
4673 else if (mapped_weno) then
4674 do q = 0, weno_num_stencils
4675 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4676 end do
4677 omega = alpha/sum(alpha)
4678 do q = 0, weno_num_stencils
4679 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
4680 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
4681 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
4682 end do
4683 else if (wenoz) then
4684
4685# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4686#if defined(MFC_OpenACC)
4687# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4688!$acc loop seq
4689# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4690#elif defined(MFC_OpenMP)
4691# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4692
4693# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4694#endif
4695 do q = 0, weno_num_stencils
4696 ! wenoz_q = 2,3,4 for stability
4697 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q))**wenoz_q)
4698 end do
4699 else if (teno) then
4700
4701# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4702#if defined(MFC_OpenACC)
4703# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4704!$acc loop seq
4705# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4706#elif defined(MFC_OpenMP)
4707# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4708
4709# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4710#endif
4711 do q = 0, weno_num_stencils
4712 alpha(q) = delta(q)*d_cbr_x(q, j)
4713 end do
4714 end if
4715
4716 omega = alpha/sum(alpha)
4717
4718 vr_rs_vf_x(j, k, l, &
4719 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4720
4721 if (teno) then
4722# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4723 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4724# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4725 end if
4726 end do
4727 end do
4728 end do
4729 end do
4730
4731# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4732#if defined(MFC_OpenACC)
4733# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4734!$acc end parallel loop
4735# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4736#elif defined(MFC_OpenMP)
4737# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4738
4739# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4740!$omp end target teams loop
4741# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4742#endif
4743 end if
4744# 1227 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4745# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4746# 1229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4747 if (weno_dir == 2) then
4748
4749# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4750
4751# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4752#if defined(MFC_OpenACC)
4753# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4754!$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)
4755# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4756#elif defined(MFC_OpenMP)
4757# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4758
4759# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4760
4761# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4762
4763# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4764!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
4765# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4766!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
4767# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4768#endif
4769# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4770 do l = is3_weno%beg, is3_weno%end
4771 do k = is1_weno%beg, is1_weno%end
4772 do j = is2_weno%beg, is2_weno%end
4773
4774# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4775#if defined(MFC_OpenACC)
4776# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4777!$acc loop seq
4778# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4779#elif defined(MFC_OpenMP)
4780# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4781
4782# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4783#endif
4784 do i = 1, v_size
4785 alpha(:) = 0._wp
4786
4787 vp0 = v_rs_weno(j, k, l, i)
4788 vm1 = v_rs_weno(j, k - 1, l, i)
4789 vm2 = v_rs_weno(j, k - 2, l, i)
4790 vm3 = v_rs_weno(j, k - 3, l, i)
4791 vp1 = v_rs_weno(j, k + 1, l, i)
4792 vp2 = v_rs_weno(j, k + 2, l, i)
4793 vp3 = v_rs_weno(j, k + 3, l, i)
4794
4795 if (teno) then
4796 v(-3) = vm3
4797 v(-2) = vm2
4798 v(-1) = vm1
4799 v(0) = vp0
4800 v(1) = vp1
4801 v(2) = vp2
4802 v(3) = vp3
4803 end if
4804
4805 if (.not. teno) then
4806 dvd(2) = vp3 - vp2
4807 dvd(1) = vp2 - vp1
4808 dvd(0) = vp1 - vp0
4809 dvd(-1) = vp0 - vm1
4810 dvd(-2) = vm1 - vm2
4811 dvd(-3) = vm2 - vm3
4812
4813 poly(3) = vp0 + poly_coef_cbl_y(k, 0, &
4814 & 0)*dvd(2) + poly_coef_cbl_y(k, 0, &
4815 & 1)*dvd(1) + poly_coef_cbl_y(k, 0, 2)*dvd(0)
4816 poly(2) = vp0 + poly_coef_cbl_y(k, 1, &
4817 & 0)*dvd(1) + poly_coef_cbl_y(k, 1, &
4818 & 1)*dvd(0) + poly_coef_cbl_y(k, 1, 2)*dvd(-1)
4819 poly(1) = vp0 + poly_coef_cbl_y(k, 2, &
4820 & 0)*dvd(0) + poly_coef_cbl_y(k, 2, &
4821 & 1)*dvd(-1) + poly_coef_cbl_y(k, 2, 2)*dvd(-2)
4822 poly(0) = vp0 + poly_coef_cbl_y(k, 3, &
4823 & 0)*dvd(-1) + poly_coef_cbl_y(k, 3, &
4824 & 1)*dvd(-2) + poly_coef_cbl_y(k, 3, 2)*dvd(-3)
4825 else
4826# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4827 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4828 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4829 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4830 ! to keep the stencil order to reuse the beta coefficients
4831 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4832 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4833 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4834 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4835 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4836# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4837 end if
4838
4839 if (.not. teno) then
4840 beta(3) = beta_coef_y(k, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(k, &
4841 & 0, 1)*dvd(2)*dvd(1) + beta_coef_y(k, 0, &
4842 & 2)*dvd(2)*dvd(0) + beta_coef_y(k, 0, &
4843 & 3)*dvd(1)*dvd(1) + beta_coef_y(k, 0, &
4844 & 4)*dvd(1)*dvd(0) + beta_coef_y(k, 0, 5)*dvd(0)*dvd(0) + weno_eps
4845
4846 beta(2) = beta_coef_y(k, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(k, &
4847 & 1, 1)*dvd(1)*dvd(0) + beta_coef_y(k, 1, &
4848 & 2)*dvd(1)*dvd(-1) + beta_coef_y(k, 1, &
4849 & 3)*dvd(0)*dvd(0) + beta_coef_y(k, 1, &
4850 & 4)*dvd(0)*dvd(-1) + beta_coef_y(k, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4851
4852 beta(1) = beta_coef_y(k, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(k, &
4853 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_y(k, 2, &
4854 & 2)*dvd(0)*dvd(-2) + beta_coef_y(k, 2, &
4855 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(k, 2, &
4856 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(k, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4857
4858 beta(0) = beta_coef_y(k, 3, &
4859 & 0)*dvd(-1)*dvd(-1) + beta_coef_y(k, 3, &
4860 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(k, 3, &
4861 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(k, 3, &
4862 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(k, 3, &
4863 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(k, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4864 else
4865# 1318 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4866 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4867 ! & Tang, 2019) Section 3.2
4868 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4869 & **2._wp)/4._wp + weno_eps
4870 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4871 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4872 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4873 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4874
4875 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4876 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4877 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4878
4879 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4880 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4881 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4882# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4883 end if
4884
4885 if (wenojs) then
4886 do q = 0, weno_num_stencils
4887 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4888 end do
4889 else if (mapped_weno) then
4890 do q = 0, weno_num_stencils
4891 alpha(q) = d_cbl_y(q, k)/(beta(q)**2._wp)
4892 end do
4893 omega = alpha/sum(alpha)
4894 do q = 0, weno_num_stencils
4895 alpha(q) = (d_cbl_y(q, k)*(1._wp + d_cbl_y(q, &
4896 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4897 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, k))))
4898 end do
4899 else if (wenoz) then
4900 ! Castro, et al. (2010) Don & Borges (2013) also helps
4901 tau = abs(beta(3) - beta(0)) ! Equation 50
4902
4903# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4904#if defined(MFC_OpenACC)
4905# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4906!$acc loop seq
4907# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4908#elif defined(MFC_OpenMP)
4909# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4910
4911# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4912#endif
4913 do q = 0, weno_num_stencils
4914 ! wenoz_q = 2,3,4 for stability
4915 alpha(q) = d_cbl_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
4916 end do
4917 else if (teno) then
4918# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4919 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4920 alpha = 1._wp + tau/beta
4921 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4922 omega = alpha/sum(alpha)
4923
4924
4925# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4926#if defined(MFC_OpenACC)
4927# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4928!$acc loop seq
4929# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4930#elif defined(MFC_OpenMP)
4931# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4932
4933# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4934#endif
4935 do q = 0, weno_num_stencils
4936 if (omega(q) < teno_ct) then ! Equation 26
4937 delta(q) = 0._wp
4938 else
4939 delta(q) = 1._wp
4940 end if
4941 alpha(q) = delta(q)*d_cbl_y(q, k) ! Equation 27
4942 end do
4943# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4944 end if
4945
4946 omega = alpha/sum(alpha)
4947
4948 vl_rs_vf_x(j, k, l, &
4949 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
4950
4951 if (teno) then
4952# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4953 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4954# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4955 end if
4956
4957 if (.not. teno) then
4958 poly(3) = vp0 + poly_coef_cbr_y(k, 0, &
4959 & 0)*dvd(2) + poly_coef_cbr_y(k, 0, &
4960 & 1)*dvd(1) + poly_coef_cbr_y(k, 0, 2)*dvd(0)
4961 poly(2) = vp0 + poly_coef_cbr_y(k, 1, &
4962 & 0)*dvd(1) + poly_coef_cbr_y(k, 1, &
4963 & 1)*dvd(0) + poly_coef_cbr_y(k, 1, 2)*dvd(-1)
4964 poly(1) = vp0 + poly_coef_cbr_y(k, 2, &
4965 & 0)*dvd(0) + poly_coef_cbr_y(k, 2, &
4966 & 1)*dvd(-1) + poly_coef_cbr_y(k, 2, 2)*dvd(-2)
4967 poly(0) = vp0 + poly_coef_cbr_y(k, 3, &
4968 & 0)*dvd(-1) + poly_coef_cbr_y(k, 3, &
4969 & 1)*dvd(-2) + poly_coef_cbr_y(k, 3, 2)*dvd(-3)
4970 else
4971# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4972 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4973 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4974 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4975 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4976 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4977# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4978 end if
4979
4980 if (wenojs) then
4981 do q = 0, weno_num_stencils
4982 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4983 end do
4984 else if (mapped_weno) then
4985 do q = 0, weno_num_stencils
4986 alpha(q) = d_cbr_y(q, k)/(beta(q)**2._wp)
4987 end do
4988 omega = alpha/sum(alpha)
4989 do q = 0, weno_num_stencils
4990 alpha(q) = (d_cbr_y(q, k)*(1._wp + d_cbr_y(q, &
4991 & k) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4992 & k)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, k))))
4993 end do
4994 else if (wenoz) then
4995
4996# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4997#if defined(MFC_OpenACC)
4998# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4999!$acc loop seq
5000# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5001#elif defined(MFC_OpenMP)
5002# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5003
5004# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5005#endif
5006 do q = 0, weno_num_stencils
5007 ! wenoz_q = 2,3,4 for stability
5008 alpha(q) = d_cbr_y(q, k)*(1._wp + (tau/beta(q))**wenoz_q)
5009 end do
5010 else if (teno) then
5011
5012# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5013#if defined(MFC_OpenACC)
5014# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5015!$acc loop seq
5016# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5017#elif defined(MFC_OpenMP)
5018# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5019
5020# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5021#endif
5022 do q = 0, weno_num_stencils
5023 alpha(q) = delta(q)*d_cbr_y(q, k)
5024 end do
5025 end if
5026
5027 omega = alpha/sum(alpha)
5028
5029 vr_rs_vf_x(j, k, l, &
5030 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5031
5032 if (teno) then
5033# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5034 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5035# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5036 end if
5037 end do
5038 end do
5039 end do
5040 end do
5041
5042# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5043#if defined(MFC_OpenACC)
5044# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5045!$acc end parallel loop
5046# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5047#elif defined(MFC_OpenMP)
5048# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5049
5050# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5051!$omp end target teams loop
5052# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5053#endif
5054 end if
5055# 1227 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5056# 1228 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5057# 1229 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5058 if (weno_dir == 3) then
5059
5060# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5061
5062# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5063#if defined(MFC_OpenACC)
5064# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5065!$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)
5066# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5067#elif defined(MFC_OpenMP)
5068# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5069
5070# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5071
5072# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5073
5074# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5075!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5076# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5077!$omp& private(poly, beta, alpha, omega, tau, delta, dvd, v, q, vp0, vp1, vp2, vp3, vm1, vm2, vm3)
5078# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5079#endif
5080# 1232 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5081 do l = is1_weno%beg, is1_weno%end
5082 do k = is2_weno%beg, is2_weno%end
5083 do j = is3_weno%beg, is3_weno%end
5084
5085# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5086#if defined(MFC_OpenACC)
5087# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5088!$acc loop seq
5089# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5090#elif defined(MFC_OpenMP)
5091# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5092
5093# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5094#endif
5095 do i = 1, v_size
5096 alpha(:) = 0._wp
5097
5098 vp0 = v_rs_weno(j, k, l, i)
5099 vm1 = v_rs_weno(j, k, l - 1, i)
5100 vm2 = v_rs_weno(j, k, l - 2, i)
5101 vm3 = v_rs_weno(j, k, l - 3, i)
5102 vp1 = v_rs_weno(j, k, l + 1, i)
5103 vp2 = v_rs_weno(j, k, l + 2, i)
5104 vp3 = v_rs_weno(j, k, l + 3, i)
5105
5106 if (teno) then
5107 v(-3) = vm3
5108 v(-2) = vm2
5109 v(-1) = vm1
5110 v(0) = vp0
5111 v(1) = vp1
5112 v(2) = vp2
5113 v(3) = vp3
5114 end if
5115
5116 if (.not. teno) then
5117 dvd(2) = vp3 - vp2
5118 dvd(1) = vp2 - vp1
5119 dvd(0) = vp1 - vp0
5120 dvd(-1) = vp0 - vm1
5121 dvd(-2) = vm1 - vm2
5122 dvd(-3) = vm2 - vm3
5123
5124 poly(3) = vp0 + poly_coef_cbl_z(l, 0, &
5125 & 0)*dvd(2) + poly_coef_cbl_z(l, 0, &
5126 & 1)*dvd(1) + poly_coef_cbl_z(l, 0, 2)*dvd(0)
5127 poly(2) = vp0 + poly_coef_cbl_z(l, 1, &
5128 & 0)*dvd(1) + poly_coef_cbl_z(l, 1, &
5129 & 1)*dvd(0) + poly_coef_cbl_z(l, 1, 2)*dvd(-1)
5130 poly(1) = vp0 + poly_coef_cbl_z(l, 2, &
5131 & 0)*dvd(0) + poly_coef_cbl_z(l, 2, &
5132 & 1)*dvd(-1) + poly_coef_cbl_z(l, 2, 2)*dvd(-2)
5133 poly(0) = vp0 + poly_coef_cbl_z(l, 3, &
5134 & 0)*dvd(-1) + poly_coef_cbl_z(l, 3, &
5135 & 1)*dvd(-2) + poly_coef_cbl_z(l, 3, 2)*dvd(-3)
5136 else
5137# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5138 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
5139 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
5140 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
5141 ! to keep the stencil order to reuse the beta coefficients
5142 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
5143 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
5144 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
5145 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
5146 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
5147# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5148 end if
5149
5150 if (.not. teno) then
5151 beta(3) = beta_coef_z(l, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(l, &
5152 & 0, 1)*dvd(2)*dvd(1) + beta_coef_z(l, 0, &
5153 & 2)*dvd(2)*dvd(0) + beta_coef_z(l, 0, &
5154 & 3)*dvd(1)*dvd(1) + beta_coef_z(l, 0, &
5155 & 4)*dvd(1)*dvd(0) + beta_coef_z(l, 0, 5)*dvd(0)*dvd(0) + weno_eps
5156
5157 beta(2) = beta_coef_z(l, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(l, &
5158 & 1, 1)*dvd(1)*dvd(0) + beta_coef_z(l, 1, &
5159 & 2)*dvd(1)*dvd(-1) + beta_coef_z(l, 1, &
5160 & 3)*dvd(0)*dvd(0) + beta_coef_z(l, 1, &
5161 & 4)*dvd(0)*dvd(-1) + beta_coef_z(l, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
5162
5163 beta(1) = beta_coef_z(l, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(l, &
5164 & 2, 1)*dvd(0)*dvd(-1) + beta_coef_z(l, 2, &
5165 & 2)*dvd(0)*dvd(-2) + beta_coef_z(l, 2, &
5166 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(l, 2, &
5167 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(l, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
5168
5169 beta(0) = beta_coef_z(l, 3, &
5170 & 0)*dvd(-1)*dvd(-1) + beta_coef_z(l, 3, &
5171 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(l, 3, &
5172 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(l, 3, &
5173 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(l, 3, &
5174 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(l, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5175 else
5176# 1318 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5177 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5178 ! & Tang, 2019) Section 3.2
5179 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5180 & **2._wp)/4._wp + weno_eps
5181 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5182 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5183 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5184 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5185
5186 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5187 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5188 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5189
5190 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5191 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5192 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5193# 1335 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5194 end if
5195
5196 if (wenojs) then
5197 do q = 0, weno_num_stencils
5198 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5199 end do
5200 else if (mapped_weno) then
5201 do q = 0, weno_num_stencils
5202 alpha(q) = d_cbl_z(q, l)/(beta(q)**2._wp)
5203 end do
5204 omega = alpha/sum(alpha)
5205 do q = 0, weno_num_stencils
5206 alpha(q) = (d_cbl_z(q, l)*(1._wp + d_cbl_z(q, &
5207 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
5208 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, l))))
5209 end do
5210 else if (wenoz) then
5211 ! Castro, et al. (2010) Don & Borges (2013) also helps
5212 tau = abs(beta(3) - beta(0)) ! Equation 50
5213
5214# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5215#if defined(MFC_OpenACC)
5216# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5217!$acc loop seq
5218# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219#elif defined(MFC_OpenMP)
5220# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5221
5222# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5223#endif
5224 do q = 0, weno_num_stencils
5225 ! wenoz_q = 2,3,4 for stability
5226 alpha(q) = d_cbl_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5227 end do
5228 else if (teno) then
5229# 1361 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5230 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5231 alpha = 1._wp + tau/beta
5232 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5233 omega = alpha/sum(alpha)
5234
5235
5236# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5237#if defined(MFC_OpenACC)
5238# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5239!$acc loop seq
5240# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5241#elif defined(MFC_OpenMP)
5242# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5243
5244# 1366 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5245#endif
5246 do q = 0, weno_num_stencils
5247 if (omega(q) < teno_ct) then ! Equation 26
5248 delta(q) = 0._wp
5249 else
5250 delta(q) = 1._wp
5251 end if
5252 alpha(q) = delta(q)*d_cbl_z(q, l) ! Equation 27
5253 end do
5254# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5255 end if
5256
5257 omega = alpha/sum(alpha)
5258
5259 vl_rs_vf_x(j, k, l, &
5260 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5261
5262 if (teno) then
5263# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5264 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5265# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5266 end if
5267
5268 if (.not. teno) then
5269 poly(3) = vp0 + poly_coef_cbr_z(l, 0, &
5270 & 0)*dvd(2) + poly_coef_cbr_z(l, 0, &
5271 & 1)*dvd(1) + poly_coef_cbr_z(l, 0, 2)*dvd(0)
5272 poly(2) = vp0 + poly_coef_cbr_z(l, 1, &
5273 & 0)*dvd(1) + poly_coef_cbr_z(l, 1, &
5274 & 1)*dvd(0) + poly_coef_cbr_z(l, 1, 2)*dvd(-1)
5275 poly(1) = vp0 + poly_coef_cbr_z(l, 2, &
5276 & 0)*dvd(0) + poly_coef_cbr_z(l, 2, &
5277 & 1)*dvd(-1) + poly_coef_cbr_z(l, 2, 2)*dvd(-2)
5278 poly(0) = vp0 + poly_coef_cbr_z(l, 3, &
5279 & 0)*dvd(-1) + poly_coef_cbr_z(l, 3, &
5280 & 1)*dvd(-2) + poly_coef_cbr_z(l, 3, 2)*dvd(-3)
5281 else
5282# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5283 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5284 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5285 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5286 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5287 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5288# 1410 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5289 end if
5290
5291 if (wenojs) then
5292 do q = 0, weno_num_stencils
5293 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5294 end do
5295 else if (mapped_weno) then
5296 do q = 0, weno_num_stencils
5297 alpha(q) = d_cbr_z(q, l)/(beta(q)**2._wp)
5298 end do
5299 omega = alpha/sum(alpha)
5300 do q = 0, weno_num_stencils
5301 alpha(q) = (d_cbr_z(q, l)*(1._wp + d_cbr_z(q, &
5302 & l) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
5303 & l)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, l))))
5304 end do
5305 else if (wenoz) then
5306
5307# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5308#if defined(MFC_OpenACC)
5309# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5310!$acc loop seq
5311# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5312#elif defined(MFC_OpenMP)
5313# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5314
5315# 1427 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5316#endif
5317 do q = 0, weno_num_stencils
5318 ! wenoz_q = 2,3,4 for stability
5319 alpha(q) = d_cbr_z(q, l)*(1._wp + (tau/beta(q))**wenoz_q)
5320 end do
5321 else if (teno) then
5322
5323# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5324#if defined(MFC_OpenACC)
5325# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5326!$acc loop seq
5327# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5328#elif defined(MFC_OpenMP)
5329# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5330
5331# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5332#endif
5333 do q = 0, weno_num_stencils
5334 alpha(q) = delta(q)*d_cbr_z(q, l)
5335 end do
5336 end if
5337
5338 omega = alpha/sum(alpha)
5339
5340 vr_rs_vf_x(j, k, l, &
5341 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3)*poly(3)
5342
5343 if (teno) then
5344# 1446 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5345 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
5346# 1448 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5347 end if
5348 end do
5349 end do
5350 end do
5351 end do
5352
5353# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5354#if defined(MFC_OpenACC)
5355# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5356!$acc end parallel loop
5357# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5358#elif defined(MFC_OpenMP)
5359# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5360
5361# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5362!$omp end target teams loop
5363# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5364#endif
5365 end if
5366# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5367# 1457 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5368 end if
5369
5370 if (int_comp > 0 .and. v_size >= eqn_idx%adv%end) then
5371 call nvtxstartrange("WENO-INTCOMP")
5372 call s_thinc_compression(v_rs_weno, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno, is2_weno, is3_weno)
5373 call nvtxendrange()
5374 end if
5375
5376 end subroutine s_weno
5377
5378 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5379 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf, weno_dir)
5380
5381 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5382 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5383 integer, intent(in) :: weno_dir
5384 integer :: i, j, k, l
5385 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5386 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5387 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5388 ! the cell- average variables.
5389 real(wp) :: vL_UL, vR_UL
5390 real(wp) :: vL_MD, vR_MD
5391 real(wp) :: vL_LC, vR_LC
5392 real(wp) :: vL_min, vR_min
5393 real(wp) :: vL_max, vR_max
5394 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5395 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5396 real(wp), parameter :: alpha_mp = 2._wp
5397 real(wp), parameter :: beta_mp = 4._wp/3._wp
5398 real(wp) :: vp0, vp1, vp2, vm1, vm2
5399
5400# 1493 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5401# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5402# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5403 if (weno_dir == 1) then
5404
5405# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5406
5407# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5408#if defined(MFC_OpenACC)
5409# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5410!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5411# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5412#elif defined(MFC_OpenMP)
5413# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5414
5415# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5416
5417# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5418
5419# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5420!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5421# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5422!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5423# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5424#endif
5425 do l = is3_weno%beg, is3_weno%end
5426 do k = is2_weno%beg, is2_weno%end
5427 do j = is1_weno%beg, is1_weno%end
5428 do i = 1, v_size
5429 ! Second-order undivided differences for curvature estimation
5430
5431 vp0 = v_rs_ws(j, k, l, i)
5432 vm1 = v_rs_ws(j - 1, k, l, i)
5433 vm2 = v_rs_ws(j - 2, k, l, i)
5434 vp1 = v_rs_ws(j + 1, k, l, i)
5435 vp2 = v_rs_ws(j + 2, k, l, i)
5436
5437 d(-1) = vp0 + vm2 - vm1*2._wp
5438 d(0) = vp1 + vm1 - vp0*2._wp
5439 d(1) = vp2 + vp0 - vp1*2._wp
5440
5441 ! Median function for oscillation detection
5442 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5443 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5444 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5445 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5446
5447 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5448 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5449 & 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
5450
5451 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5452
5453 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5454
5455 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5456
5457 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5458
5459 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5460
5461 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, &
5462 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5463 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5464 ! END: Left Monotonicity Preserving Bound
5465
5466 ! Right Monotonicity Preserving Bound
5467 d(-1) = vp0 + vm2 - vm1*2._wp
5468 d(0) = vp1 + vm1 - vp0*2._wp
5469 d(1) = vp2 + vp0 - vp1*2._wp
5470
5471 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5472 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5473 & 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
5474
5475 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5476 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5477 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5478 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5479
5480 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5481
5482 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5483
5484 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5485
5486 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5487
5488 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5489
5490 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, &
5491 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5492 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5493 ! END: Right Monotonicity Preserving Bound
5494 end do
5495 end do
5496 end do
5497 end do
5498
5499# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5500#if defined(MFC_OpenACC)
5501# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5502!$acc end parallel loop
5503# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5504#elif defined(MFC_OpenMP)
5505# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5506
5507# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5508!$omp end target teams loop
5509# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5510#endif
5511 end if
5512# 1493 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5513# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5514# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5515 if (weno_dir == 2) then
5516
5517# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5518
5519# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5520#if defined(MFC_OpenACC)
5521# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5522!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5523# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5524#elif defined(MFC_OpenMP)
5525# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5526
5527# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5528
5529# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5530
5531# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5532!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5533# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5534!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5535# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5536#endif
5537 do l = is3_weno%beg, is3_weno%end
5538 do k = is1_weno%beg, is1_weno%end
5539 do j = is2_weno%beg, is2_weno%end
5540 do i = 1, v_size
5541 ! Second-order undivided differences for curvature estimation
5542
5543 vp0 = v_rs_ws(j, k, l, i)
5544 vm1 = v_rs_ws(j, k - 1, l, i)
5545 vm2 = v_rs_ws(j, k - 2, l, i)
5546 vp1 = v_rs_ws(j, k + 1, l, i)
5547 vp2 = v_rs_ws(j, k + 2, l, i)
5548
5549 d(-1) = vp0 + vm2 - vm1*2._wp
5550 d(0) = vp1 + vm1 - vp0*2._wp
5551 d(1) = vp2 + vp0 - vp1*2._wp
5552
5553 ! Median function for oscillation detection
5554 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5555 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5556 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5557 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5558
5559 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5560 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5561 & 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
5562
5563 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5564
5565 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5566
5567 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5568
5569 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5570
5571 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5572
5573 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, &
5574 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5575 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5576 ! END: Left Monotonicity Preserving Bound
5577
5578 ! Right Monotonicity Preserving Bound
5579 d(-1) = vp0 + vm2 - vm1*2._wp
5580 d(0) = vp1 + vm1 - vp0*2._wp
5581 d(1) = vp2 + vp0 - vp1*2._wp
5582
5583 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5584 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5585 & 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
5586
5587 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5588 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5589 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5590 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5591
5592 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5593
5594 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5595
5596 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5597
5598 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5599
5600 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5601
5602 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, &
5603 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5604 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5605 ! END: Right Monotonicity Preserving Bound
5606 end do
5607 end do
5608 end do
5609 end do
5610
5611# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5612#if defined(MFC_OpenACC)
5613# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5614!$acc end parallel loop
5615# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5616#elif defined(MFC_OpenMP)
5617# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5618
5619# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5620!$omp end target teams loop
5621# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5622#endif
5623 end if
5624# 1493 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5625# 1494 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5626# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5627 if (weno_dir == 3) then
5628
5629# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5630
5631# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5632#if defined(MFC_OpenACC)
5633# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5634!$acc parallel loop collapse(4) gang vector default(present) private(d, vp0, vp1, vp2, vm1, vm2)
5635# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5636#elif defined(MFC_OpenMP)
5637# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5638
5639# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5640
5641# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5642
5643# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5644!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
5645# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5646!$omp& private(d, vp0, vp1, vp2, vm1, vm2)
5647# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5648#endif
5649 do l = is1_weno%beg, is1_weno%end
5650 do k = is2_weno%beg, is2_weno%end
5651 do j = is3_weno%beg, is3_weno%end
5652 do i = 1, v_size
5653 ! Second-order undivided differences for curvature estimation
5654
5655 vp0 = v_rs_ws(j, k, l, i)
5656 vm1 = v_rs_ws(j, k, l - 1, i)
5657 vm2 = v_rs_ws(j, k, l - 2, i)
5658 vp1 = v_rs_ws(j, k, l + 1, i)
5659 vp2 = v_rs_ws(j, k, l + 2, i)
5660
5661 d(-1) = vp0 + vm2 - vm1*2._wp
5662 d(0) = vp1 + vm1 - vp0*2._wp
5663 d(1) = vp2 + vp0 - vp1*2._wp
5664
5665 ! Median function for oscillation detection
5666 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5667 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5668 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5669 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5670
5671 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5672 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5673 & 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
5674
5675 vl_ul = vp0 - (vp1 - vp0)*alpha_mp
5676
5677 vl_md = (vp0 + vm1 - d_md)*5.e-1_wp
5678
5679 vl_lc = vp0 - (vp1 - vp0)*5.e-1_wp + beta_mp*d_lc
5680
5681 vl_min = max(min(vp0, vm1, vl_md), min(vp0, vl_ul, vl_lc))
5682
5683 vl_max = min(max(vp0, vm1, vl_md), max(vp0, vl_ul, vl_lc))
5684
5685 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, &
5686 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, &
5687 & l, i)), abs(vl_max - vl_rs_vf(j, k, l, i)))
5688 ! END: Left Monotonicity Preserving Bound
5689
5690 ! Right Monotonicity Preserving Bound
5691 d(-1) = vp0 + vm2 - vm1*2._wp
5692 d(0) = vp1 + vm1 - vp0*2._wp
5693 d(1) = vp2 + vp0 - vp1*2._wp
5694
5695 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5696 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5697 & 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
5698
5699 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5700 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, &
5701 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), &
5702 & abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5703
5704 vr_ul = vp0 + (vp0 - vm1)*alpha_mp
5705
5706 vr_md = (vp0 + vp1 - d_md)*5.e-1_wp
5707
5708 vr_lc = vp0 + (vp0 - vm1)*5.e-1_wp + beta_mp*d_lc
5709
5710 vr_min = max(min(vp0, vp1, vr_md), min(vp0, vr_ul, vr_lc))
5711
5712 vr_max = min(max(vp0, vp1, vr_md), max(vp0, vr_ul, vr_lc))
5713
5714 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, &
5715 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, &
5716 & l, i)), abs(vr_max - vr_rs_vf(j, k, l, i)))
5717 ! END: Right Monotonicity Preserving Bound
5718 end do
5719 end do
5720 end do
5721 end do
5722
5723# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5724#if defined(MFC_OpenACC)
5725# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5726!$acc end parallel loop
5727# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5728#elif defined(MFC_OpenMP)
5729# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5730
5731# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5732!$omp end target teams loop
5733# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5734#endif
5735 end if
5736# 1573 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5737
5738 end subroutine s_preserve_monotonicity
5739
5740 !> Module deallocation and/or disassociation procedures
5741 impure subroutine s_finalize_weno_module()
5742
5743 if (weno_order == 1) return
5744
5745 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5746
5747#ifdef MFC_DEBUG
5748# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5749 block
5750# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5751 use iso_fortran_env, only: output_unit
5752# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5753
5754# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5755 print *, 'm_weno.fpp:1583: ', '@:DEALLOCATE(v_rs_weno)'
5756# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5757
5758# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5759 call flush (output_unit)
5760# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5761 end block
5762# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5763#endif
5764# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5765
5766# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5767#if defined(MFC_OpenACC)
5768# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5769!$acc exit data delete(v_rs_weno)
5770# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5771#elif defined(MFC_OpenMP)
5772# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5773!$omp target exit data map(release:v_rs_weno)
5774# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5775#endif
5776# 1583 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5777 deallocate (v_rs_weno)
5778
5779 ! Deallocating WENO coefficients in x-direction
5780#ifdef MFC_DEBUG
5781# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5782 block
5783# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5784 use iso_fortran_env, only: output_unit
5785# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5786
5787# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5788 print *, 'm_weno.fpp:1586: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5789# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5790
5791# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5792 call flush (output_unit)
5793# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5794 end block
5795# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5796#endif
5797# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5798
5799# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5800#if defined(MFC_OpenACC)
5801# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5802!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5803# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5804#elif defined(MFC_OpenMP)
5805# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5806!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5807# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5808#endif
5809# 1586 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5810 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5811#ifdef MFC_DEBUG
5812# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5813 block
5814# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5815 use iso_fortran_env, only: output_unit
5816# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5817
5818# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5819 print *, 'm_weno.fpp:1587: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5820# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5821
5822# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5823 call flush (output_unit)
5824# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5825 end block
5826# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5827#endif
5828# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5829
5830# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5831#if defined(MFC_OpenACC)
5832# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5833!$acc exit data delete(d_cbL_x, d_cbR_x)
5834# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5835#elif defined(MFC_OpenMP)
5836# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5837!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5838# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5839#endif
5840# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5841 deallocate (d_cbl_x, d_cbr_x)
5842#ifdef MFC_DEBUG
5843# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844 block
5845# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5846 use iso_fortran_env, only: output_unit
5847# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5848
5849# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5850 print *, 'm_weno.fpp:1588: ', '@:DEALLOCATE(beta_coef_x)'
5851# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5852
5853# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5854 call flush (output_unit)
5855# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5856 end block
5857# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5858#endif
5859# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5860
5861# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5862#if defined(MFC_OpenACC)
5863# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5864!$acc exit data delete(beta_coef_x)
5865# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5866#elif defined(MFC_OpenMP)
5867# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5868!$omp target exit data map(release:beta_coef_x)
5869# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5870#endif
5871# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5872 deallocate (beta_coef_x)
5873
5874 ! Deallocating WENO coefficients in y-direction
5875 if (n == 0) return
5876
5877#ifdef MFC_DEBUG
5878# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879 block
5880# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5881 use iso_fortran_env, only: output_unit
5882# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5883
5884# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5885 print *, 'm_weno.fpp:1593: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5886# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5887
5888# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5889 call flush (output_unit)
5890# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5891 end block
5892# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5893#endif
5894# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5895
5896# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5897#if defined(MFC_OpenACC)
5898# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5899!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5900# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5901#elif defined(MFC_OpenMP)
5902# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5903!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5904# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5905#endif
5906# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5907 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5908#ifdef MFC_DEBUG
5909# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5910 block
5911# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5912 use iso_fortran_env, only: output_unit
5913# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5914
5915# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5916 print *, 'm_weno.fpp:1594: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5917# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5918
5919# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5920 call flush (output_unit)
5921# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5922 end block
5923# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5924#endif
5925# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5926
5927# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5928#if defined(MFC_OpenACC)
5929# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5930!$acc exit data delete(d_cbL_y, d_cbR_y)
5931# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5932#elif defined(MFC_OpenMP)
5933# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5934!$omp target exit data map(release:d_cbL_y, d_cbR_y)
5935# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5936#endif
5937# 1594 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5938 deallocate (d_cbl_y, d_cbr_y)
5939#ifdef MFC_DEBUG
5940# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5941 block
5942# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5943 use iso_fortran_env, only: output_unit
5944# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5945
5946# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5947 print *, 'm_weno.fpp:1595: ', '@:DEALLOCATE(beta_coef_y)'
5948# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5949
5950# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5951 call flush (output_unit)
5952# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5953 end block
5954# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5955#endif
5956# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5957
5958# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5959#if defined(MFC_OpenACC)
5960# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5961!$acc exit data delete(beta_coef_y)
5962# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5963#elif defined(MFC_OpenMP)
5964# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5965!$omp target exit data map(release:beta_coef_y)
5966# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5967#endif
5968# 1595 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5969 deallocate (beta_coef_y)
5970
5971 ! Deallocating WENO coefficients in z-direction
5972 if (p == 0) return
5973
5974#ifdef MFC_DEBUG
5975# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5976 block
5977# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5978 use iso_fortran_env, only: output_unit
5979# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5980
5981# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5982 print *, 'm_weno.fpp:1600: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
5983# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5984
5985# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5986 call flush (output_unit)
5987# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5988 end block
5989# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5990#endif
5991# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5992
5993# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5994#if defined(MFC_OpenACC)
5995# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5996!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
5997# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5998#elif defined(MFC_OpenMP)
5999# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6000!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
6001# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6002#endif
6003# 1600 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6004 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
6005#ifdef MFC_DEBUG
6006# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6007 block
6008# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6009 use iso_fortran_env, only: output_unit
6010# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6011
6012# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6013 print *, 'm_weno.fpp:1601: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
6014# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6015
6016# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6017 call flush (output_unit)
6018# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6019 end block
6020# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6021#endif
6022# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6023
6024# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6025#if defined(MFC_OpenACC)
6026# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6027!$acc exit data delete(d_cbL_z, d_cbR_z)
6028# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6029#elif defined(MFC_OpenMP)
6030# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6031!$omp target exit data map(release:d_cbL_z, d_cbR_z)
6032# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6033#endif
6034# 1601 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6035 deallocate (d_cbl_z, d_cbr_z)
6036#ifdef MFC_DEBUG
6037# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6038 block
6039# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6040 use iso_fortran_env, only: output_unit
6041# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6042
6043# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6044 print *, 'm_weno.fpp:1602: ', '@:DEALLOCATE(beta_coef_z)'
6045# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6046
6047# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6048 call flush (output_unit)
6049# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6050 end block
6051# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6052#endif
6053# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6054
6055# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6056#if defined(MFC_OpenACC)
6057# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6058!$acc exit data delete(beta_coef_z)
6059# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6060#elif defined(MFC_OpenMP)
6061# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6062!$omp target exit data map(release:beta_coef_z)
6063# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6064#endif
6065# 1602 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
6066 deallocate (beta_coef_z)
6067
6068 end subroutine s_finalize_weno_module
6069
6070end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1078
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1078
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1078
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:334
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:679
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:334
m_nvtx
NVIDIA NVTX profiling API bindings for GPU performance instrumentation.
Definition m_nvtx.f90:6
m_thinc
THINC and MTHINC interface compression for volume fraction sharpening. THINC (int_comp=1): 1D directi...
Definition m_thinc.fpp.f90:329
m_thinc::s_thinc_compression
subroutine, public s_thinc_compression(v_rs_ws, vl_rs_vf_x, vr_rs_vf_x, recon_dir, is1_d, is2_d, is3_d)
Applies THINC (int_comp=1) or MTHINC (int_comp=2) interface compression to sharpen volume-fraction an...
Definition m_thinc.fpp.f90:841
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:333
m_weno::s_preserve_monotonicity
subroutine s_preserve_monotonicity(v_rs_ws, vl_rs_vf, vr_rs_vf, weno_dir)
Enforce monotonicity-preserving bounds on the WENO reconstruction.
Definition m_weno.fpp.f90:5380
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:472
m_weno::d_cbl_z
real(wp), dimension(:,:), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:405
m_weno::poly_coef_cbl_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:369
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Definition m_weno.fpp.f90:493
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:472
m_weno::d_cbl_y
real(wp), dimension(:,:), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:404
m_weno::beta_coef_y
real(wp), dimension(:,:,:), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:427
m_weno::s_pack_weno_input_arr
subroutine, public s_pack_weno_input_arr(v_vf)
Definition m_weno.fpp.f90:3110
m_weno::d_cbr_y
real(wp), dimension(:,:), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:407
m_weno::beta_coef_x
real(wp), dimension(:,:,:), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:426
m_weno::beta_coef_z
real(wp), dimension(:,:,:), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:428
m_weno::d_cbr_x
real(wp), dimension(:,:), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:406
m_weno::d_cbr_z
real(wp), dimension(:,:), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:408
m_weno::uniform_grid
logical, dimension(3) uniform_grid
True if grid spacing is uniform in each direction.
Definition m_weno.fpp.f90:457
m_weno::poly_coef_cbl_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:371
m_weno::poly_coef_cbr_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:372
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:444
m_weno::d_cbl_x
real(wp), dimension(:,:), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:403
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:472
m_weno::poly_coef_cbr_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:373
m_weno::v_rs_weno
real(wp), dimension(:,:,:,:), allocatable v_rs_weno
Definition m_weno.fpp.f90:348
m_weno::s_weno
subroutine, public s_weno(v_vf, vl_rs_vf_x, vr_rs_vf_x, weno_dir, is1_weno_d, is2_weno_d, is3_weno_d)
Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables.
Definition m_weno.fpp.f90:3160
m_weno::poly_coef_cbl_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:370
m_weno::s_compute_weno_coefficients
subroutine s_compute_weno_coefficients(weno_dir, is)
Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction.
Definition m_weno.fpp.f90:1088
m_weno::poly_coef_cbr_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:374
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5742
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:417