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# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
12
13! For moving immersed boundaries in simulation
14# 14 "/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! New line at end of file is required for FYPP
43# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
44# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
45# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
46# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
48# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63
64# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
65
66# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
67
68# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69! New line at end of file is required for FYPP
70# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
71
72# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
74# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148! New line at end of file is required for FYPP
149# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
150# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
151# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
152# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171
172# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175! New line at end of file is required for FYPP
176# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
177
178# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229
230# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
231
232# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
233! New line at end of file is required for FYPP
234# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
235
236! GPU parallel region (scalar reductions, maxval/minval)
237# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
238
239! GPU parallel loop over threads (most common GPU macro)
240# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242! Required closing for GPU_PARALLEL_LOOP
243# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245! Mark routine for device compilation
246# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248! Declare device-resident data
249# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251! Inner loop within a GPU parallel region
252# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254! Scoped GPU data region
255# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! Host code with device pointers (for MPI with GPU buffers)
258# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Allocate device memory (unscoped)
261# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Free device memory
264# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Atomic operation on device
267# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! End atomic capture block
270# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! Copy data between host and device
273# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! Synchronization barrier
276# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Import GPU library module (openacc or omp_lib)
279# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Emit code only for AMD compiler
282# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Emit code for non-Cray compilers
285# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! Emit code only for Cray compiler
288# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Emit code for non-NVIDIA compilers
291# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295! New line at end of file is required for FYPP
296# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
297
298# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299
300! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
301! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
302! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
303# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
304
305! Allocate and create GPU device memory
306# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Free GPU device memory and deallocate
309# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Cray-specific GPU pointer setup for vector fields
312# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Cray-specific GPU pointer setup for scalar fields
315# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for acoustic source spatials
318# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
321
322# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
323! New line at end of file is required for FYPP
324# 6 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp" 2
325
326!> @brief WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights
327module m_weno
328
329 use m_derived_types
330 use m_global_parameters
331 use m_variables_conversion
332 ! $:USE_GPU_MODULE()
333
334 use m_mpi_proxy
335 use m_muscl
336 private; public :: s_initialize_weno_module, s_initialize_weno, s_finalize_weno_module, s_weno
337
338 !> @name The cell-average variables that will be WENO-reconstructed. Formerly, they are stored in v_vf. However, they are
339 !! transferred to v_rs_wsL and v_rs_wsR as to be reshaped (RS) and/or characteristically decomposed. The reshaping allows the
340 !! WENO procedure to be independent of the coordinate direction of the reconstruction. Lastly, notice that the left (L) and
341 !! right (R) results of the characteristic decomposition are stored in custom-constructed WENO- stencils (WS) that are annexed
342 !! to each position of a given scalar field.
343 !> @{
344 real(wp), allocatable, dimension(:,:,:,:) :: v_rs_ws_x, v_rs_ws_y, v_rs_ws_z
345 !> @}
346
347# 27 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
348#if defined(MFC_OpenACC)
349# 27 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
350!$acc declare create(v_rs_ws_x, v_rs_ws_y, v_rs_ws_z)
351# 27 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
352#elif defined(MFC_OpenMP)
353# 27 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
354!$omp declare target (v_rs_ws_x, v_rs_ws_y, v_rs_ws_z)
355# 27 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
356#endif
357
358 ! WENO Coefficients
359
360 !> @name Polynomial coefficients at the left and right cell-boundaries (CB) and at the left and right quadrature points (QP), in
361 !! the x-, y- and z-directions. Note that the first dimension of the array identifies the polynomial, the second dimension
362 !! identifies the position of its coefficients and the last dimension denotes the cell-location in the relevant coordinate
363 !! direction.
364 !> @{
365 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_x
366 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_y
367 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbl_z
368 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_x
369 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_y
370 real(wp), target, allocatable, dimension(:,:,:) :: poly_coef_cbr_z
371 !> @}
372
373# 43 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
374#if defined(MFC_OpenACC)
375# 43 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
376!$acc declare create(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
377# 43 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
378#elif defined(MFC_OpenMP)
379# 43 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
380!$omp declare target (poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z)
381# 43 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
382#endif
383
384# 44 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
385#if defined(MFC_OpenACC)
386# 44 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
387!$acc declare create(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
388# 44 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
389#elif defined(MFC_OpenMP)
390# 44 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
391!$omp declare target (poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z)
392# 44 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
393#endif
394
395 !> @name The ideal weights at the left and the right cell-boundaries and at the left and the right quadrature points, in x-, y-
396 !! and z-directions. Note that the first dimension of the array identifies the weight, while the last denotes the cell-location
397 !! in the relevant coordinate direction.
398 !> @{
399 real(wp), target, allocatable, dimension(:,:) :: d_cbl_x
400 real(wp), target, allocatable, dimension(:,:) :: d_cbl_y
401 real(wp), target, allocatable, dimension(:,:) :: d_cbl_z
402 real(wp), target, allocatable, dimension(:,:) :: d_cbr_x
403 real(wp), target, allocatable, dimension(:,:) :: d_cbr_y
404 real(wp), target, allocatable, dimension(:,:) :: d_cbr_z
405 !> @}
406
407# 57 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
408#if defined(MFC_OpenACC)
409# 57 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
410!$acc declare create(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
411# 57 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
412#elif defined(MFC_OpenMP)
413# 57 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
414!$omp declare target (d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z)
415# 57 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
416#endif
417
418 !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note that the first array dimension identifies the
419 !! smoothness indicator, the second identifies the position of its coefficients and the last denotes the cell-location in the
420 !! relevant coordinate direction.
421 !> @{
422 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_x
423 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_y
424 real(wp), target, allocatable, dimension(:,:,:) :: beta_coef_z
425 !> @}
426
427# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
428#if defined(MFC_OpenACC)
429# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
430!$acc declare create(beta_coef_x, beta_coef_y, beta_coef_z)
431# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
432#elif defined(MFC_OpenMP)
433# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
434!$omp declare target (beta_coef_x, beta_coef_y, beta_coef_z)
435# 67 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
436#endif
437
438 ! END: WENO Coefficients
439
440 integer :: v_size !< Number of WENO-reconstructed cell-average variables
441
442# 72 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
443#if defined(MFC_OpenACC)
444# 72 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
445!$acc declare create(v_size)
446# 72 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
447#elif defined(MFC_OpenMP)
448# 72 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
449!$omp declare target (v_size)
450# 72 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
451#endif
452
453 !> @name Indical bounds in the s1-, s2- and s3-directions
454 !> @{
455 type(int_bounds_info) :: is1_weno, is2_weno, is3_weno
456#ifndef __NVCOMPILER_GPU_UNIFIED_MEM
457
458# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
459#if defined(MFC_OpenACC)
460# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
461!$acc declare create(is1_weno, is2_weno, is3_weno)
462# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
463#elif defined(MFC_OpenMP)
464# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
465!$omp declare target (is1_weno, is2_weno, is3_weno)
466# 78 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
467#endif
468#endif
469 !
470 !> @}
471
472contains
473
474 !> Initialize the WENO module
475 impure subroutine s_initialize_weno_module
476
477 if (weno_order == 1) return
478
479 ! Allocating/Computing WENO Coefficients in x-direction
480 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
481 if (n == 0) then
482 is2_weno%beg = 0
483 else
484 is2_weno%beg = -buff_size
485 end if
486
487 is2_weno%end = n - is2_weno%beg
488
489 if (p == 0) then
490 is3_weno%beg = 0
491 else
492 is3_weno%beg = -buff_size
493 end if
494
495 is3_weno%end = p - is3_weno%beg
496
497#ifdef MFC_DEBUG
498# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
499 block
500# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
501 use iso_fortran_env, only: output_unit
502# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
503
504# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
505 print *, 'm_weno.fpp:108: ', '@:ALLOCATE(poly_coef_cbL_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
506# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
507
508# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
509 call flush (output_unit)
510# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
511 end block
512# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
513#endif
514# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
515 allocate (poly_coef_cbl_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
516# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
517
518# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
519
520# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
521#if defined(MFC_OpenACC)
522# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
523!$acc enter data create(poly_coef_cbL_x)
524# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
525#elif defined(MFC_OpenMP)
526# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
527!$omp target enter data map(always,alloc:poly_coef_cbL_x)
528# 108 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
529#endif
530#ifdef MFC_DEBUG
531# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
532 block
533# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
534 use iso_fortran_env, only: output_unit
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 print *, 'm_weno.fpp:109: ', '@:ALLOCATE(poly_coef_cbR_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
539# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
540
541# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
542 call flush (output_unit)
543# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
544 end block
545# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
546#endif
547# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
548 allocate (poly_coef_cbr_x(is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
549# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
550
551# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
552
553# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
554#if defined(MFC_OpenACC)
555# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
556!$acc enter data create(poly_coef_cbR_x)
557# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
558#elif defined(MFC_OpenMP)
559# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
560!$omp target enter data map(always,alloc:poly_coef_cbR_x)
561# 109 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
562#endif
563
564#ifdef MFC_DEBUG
565# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
566 block
567# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
568 use iso_fortran_env, only: output_unit
569# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
570
571# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
572 print *, 'm_weno.fpp:111: ', '@:ALLOCATE(d_cbL_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
573# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
574
575# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
576 call flush (output_unit)
577# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
578 end block
579# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
580#endif
581# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
582 allocate (d_cbl_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
583# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
584
585# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
586
587# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
588#if defined(MFC_OpenACC)
589# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
590!$acc enter data create(d_cbL_x)
591# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
592#elif defined(MFC_OpenMP)
593# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
594!$omp target enter data map(always,alloc:d_cbL_x)
595# 111 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
596#endif
597#ifdef MFC_DEBUG
598# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
599 block
600# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
601 use iso_fortran_env, only: output_unit
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 print *, 'm_weno.fpp:112: ', '@:ALLOCATE(d_cbR_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))'
606# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
607
608# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
609 call flush (output_unit)
610# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
611 end block
612# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
613#endif
614# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
615 allocate (d_cbr_x(0:weno_num_stencils, is1_weno%beg + weno_polyn:is1_weno%end - weno_polyn))
616# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
617
618# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
619
620# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
621#if defined(MFC_OpenACC)
622# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
623!$acc enter data create(d_cbR_x)
624# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
625#elif defined(MFC_OpenMP)
626# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
627!$omp target enter data map(always,alloc:d_cbR_x)
628# 112 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
629#endif
630
631#ifdef MFC_DEBUG
632# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
633 block
634# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
635 use iso_fortran_env, only: output_unit
636# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
637
638# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
639 print *, 'm_weno.fpp:114: ', '@: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))'
640# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
641
642# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
643 call flush (output_unit)
644# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
645 end block
646# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
647#endif
648# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
649 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))
650# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
651
652# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
653
654# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
655#if defined(MFC_OpenACC)
656# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
657!$acc enter data create(beta_coef_x)
658# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
659#elif defined(MFC_OpenMP)
660# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
661!$omp target enter data map(always,alloc:beta_coef_x)
662# 114 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
663#endif
664# 116 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
665 ! 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
666 ! differences (dvd) not the values themselves
667
668 call s_compute_weno_coefficients(1, is1_weno)
669
670#ifdef MFC_DEBUG
671# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
672 block
673# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
674 use iso_fortran_env, only: output_unit
675# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
676
677# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
678 print *, 'm_weno.fpp:121: ', '@:ALLOCATE(v_rs_ws_x(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
679# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
680
681# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
682 call flush (output_unit)
683# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
684 end block
685# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
686#endif
687# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
688 allocate (v_rs_ws_x(is1_weno%beg:is1_weno%end, is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
689# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
690
691# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
692
693# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
694#if defined(MFC_OpenACC)
695# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
696!$acc enter data create(v_rs_ws_x)
697# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
698#elif defined(MFC_OpenMP)
699# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
700!$omp target enter data map(always,alloc:v_rs_ws_x)
701# 121 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
702#endif
703
704 ! Allocating/Computing WENO Coefficients in y-direction
705 if (n == 0) return
706
707 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
708 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
709
710 if (p == 0) then
711 is3_weno%beg = 0
712 else
713 is3_weno%beg = -buff_size
714 end if
715
716 is3_weno%end = p - is3_weno%beg
717
718#ifdef MFC_DEBUG
719# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
720 block
721# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
722 use iso_fortran_env, only: output_unit
723# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
724
725# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
726 print *, 'm_weno.fpp:137: ', '@:ALLOCATE(poly_coef_cbL_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
727# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
728
729# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
730 call flush (output_unit)
731# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
732 end block
733# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
734#endif
735# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
736 allocate (poly_coef_cbl_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
737# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
738
739# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
740
741# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
742#if defined(MFC_OpenACC)
743# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
744!$acc enter data create(poly_coef_cbL_y)
745# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
746#elif defined(MFC_OpenMP)
747# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
748!$omp target enter data map(always,alloc:poly_coef_cbL_y)
749# 137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
750#endif
751#ifdef MFC_DEBUG
752# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
753 block
754# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
755 use iso_fortran_env, only: output_unit
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 print *, 'm_weno.fpp:138: ', '@:ALLOCATE(poly_coef_cbR_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
760# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
761
762# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
763 call flush (output_unit)
764# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
765 end block
766# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
767#endif
768# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
769 allocate (poly_coef_cbr_y(is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
770# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
771
772# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
773
774# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
775#if defined(MFC_OpenACC)
776# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
777!$acc enter data create(poly_coef_cbR_y)
778# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
779#elif defined(MFC_OpenMP)
780# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
781!$omp target enter data map(always,alloc:poly_coef_cbR_y)
782# 138 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
783#endif
784
785#ifdef MFC_DEBUG
786# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
787 block
788# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
789 use iso_fortran_env, only: output_unit
790# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
791
792# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
793 print *, 'm_weno.fpp:140: ', '@:ALLOCATE(d_cbL_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
794# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
795
796# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
797 call flush (output_unit)
798# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
799 end block
800# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
801#endif
802# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
803 allocate (d_cbl_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
804# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
805
806# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
807
808# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
809#if defined(MFC_OpenACC)
810# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
811!$acc enter data create(d_cbL_y)
812# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
813#elif defined(MFC_OpenMP)
814# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
815!$omp target enter data map(always,alloc:d_cbL_y)
816# 140 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
817#endif
818#ifdef MFC_DEBUG
819# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
820 block
821# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
822 use iso_fortran_env, only: output_unit
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 print *, 'm_weno.fpp:141: ', '@:ALLOCATE(d_cbR_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))'
827# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
828
829# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
830 call flush (output_unit)
831# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
832 end block
833# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
834#endif
835# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
836 allocate (d_cbr_y(0:weno_num_stencils, is2_weno%beg + weno_polyn:is2_weno%end - weno_polyn))
837# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
838
839# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
840
841# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
842#if defined(MFC_OpenACC)
843# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
844!$acc enter data create(d_cbR_y)
845# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
846#elif defined(MFC_OpenMP)
847# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
848!$omp target enter data map(always,alloc:d_cbR_y)
849# 141 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
850#endif
851
852#ifdef MFC_DEBUG
853# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
854 block
855# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
856 use iso_fortran_env, only: output_unit
857# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
858
859# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
860 print *, 'm_weno.fpp:143: ', '@: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))'
861# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
862
863# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
864 call flush (output_unit)
865# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
866 end block
867# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
868#endif
869# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
870 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))
871# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
872
873# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
874
875# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
876#if defined(MFC_OpenACC)
877# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
878!$acc enter data create(beta_coef_y)
879# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
880#elif defined(MFC_OpenMP)
881# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
882!$omp target enter data map(always,alloc:beta_coef_y)
883# 143 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
884#endif
885# 145 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
886
887 call s_compute_weno_coefficients(2, is2_weno)
888
889#ifdef MFC_DEBUG
890# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
891 block
892# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
893 use iso_fortran_env, only: output_unit
894# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
895
896# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
897 print *, 'm_weno.fpp:148: ', '@:ALLOCATE(v_rs_ws_y(is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))'
898# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
899
900# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
901 call flush (output_unit)
902# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
903 end block
904# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
905#endif
906# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
907 allocate (v_rs_ws_y(is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size))
908# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
909
910# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
911
912# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
913#if defined(MFC_OpenACC)
914# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
915!$acc enter data create(v_rs_ws_y)
916# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
917#elif defined(MFC_OpenMP)
918# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
919!$omp target enter data map(always,alloc:v_rs_ws_y)
920# 148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
921#endif
922
923 ! Allocating/Computing WENO Coefficients in z-direction
924 if (p == 0) return
925
926 is2_weno%beg = -buff_size; is2_weno%end = n - is2_weno%beg
927 is1_weno%beg = -buff_size; is1_weno%end = m - is1_weno%beg
928 is3_weno%beg = -buff_size; is3_weno%end = p - is3_weno%beg
929
930#ifdef MFC_DEBUG
931# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
932 block
933# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
934 use iso_fortran_env, only: output_unit
935# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
936
937# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
938 print *, 'm_weno.fpp:157: ', '@:ALLOCATE(poly_coef_cbL_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
939# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
940
941# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
942 call flush (output_unit)
943# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
944 end block
945# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
946#endif
947# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
948 allocate (poly_coef_cbl_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
949# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
950
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#if defined(MFC_OpenACC)
955# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
956!$acc enter data create(poly_coef_cbL_z)
957# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
958#elif defined(MFC_OpenMP)
959# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
960!$omp target enter data map(always,alloc:poly_coef_cbL_z)
961# 157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
962#endif
963#ifdef MFC_DEBUG
964# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
965 block
966# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
967 use iso_fortran_env, only: output_unit
968# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
969
970# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
971 print *, 'm_weno.fpp:158: ', '@:ALLOCATE(poly_coef_cbR_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))'
972# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
973
974# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
975 call flush (output_unit)
976# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
977 end block
978# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
979#endif
980# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
981 allocate (poly_coef_cbr_z(is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn, 0:weno_polyn, 0:weno_polyn - 1))
982# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
983
984# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
985
986# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
987#if defined(MFC_OpenACC)
988# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
989!$acc enter data create(poly_coef_cbR_z)
990# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
991#elif defined(MFC_OpenMP)
992# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
993!$omp target enter data map(always,alloc:poly_coef_cbR_z)
994# 158 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
995#endif
996
997#ifdef MFC_DEBUG
998# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
999 block
1000# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1001 use iso_fortran_env, only: output_unit
1002# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1003
1004# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1005 print *, 'm_weno.fpp:160: ', '@:ALLOCATE(d_cbL_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1006# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1007
1008# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1009 call flush (output_unit)
1010# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1011 end block
1012# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1013#endif
1014# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1015 allocate (d_cbl_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1016# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1017
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#if defined(MFC_OpenACC)
1022# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1023!$acc enter data create(d_cbL_z)
1024# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1025#elif defined(MFC_OpenMP)
1026# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1027!$omp target enter data map(always,alloc:d_cbL_z)
1028# 160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1029#endif
1030#ifdef MFC_DEBUG
1031# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1032 block
1033# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1034 use iso_fortran_env, only: output_unit
1035# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1036
1037# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1038 print *, 'm_weno.fpp:161: ', '@:ALLOCATE(d_cbR_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))'
1039# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1040
1041# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1042 call flush (output_unit)
1043# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1044 end block
1045# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1046#endif
1047# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1048 allocate (d_cbr_z(0:weno_num_stencils, is3_weno%beg + weno_polyn:is3_weno%end - weno_polyn))
1049# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1050
1051# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1052
1053# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1054#if defined(MFC_OpenACC)
1055# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1056!$acc enter data create(d_cbR_z)
1057# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1058#elif defined(MFC_OpenMP)
1059# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1060!$omp target enter data map(always,alloc:d_cbR_z)
1061# 161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1062#endif
1063
1064#ifdef MFC_DEBUG
1065# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1066 block
1067# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1068 use iso_fortran_env, only: output_unit
1069# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1070
1071# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1072 print *, 'm_weno.fpp:163: ', '@: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))'
1073# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1074
1075# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1076 call flush (output_unit)
1077# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1078 end block
1079# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1080#endif
1081# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1082 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))
1083# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1084
1085# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1086
1087# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1088#if defined(MFC_OpenACC)
1089# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1090!$acc enter data create(beta_coef_z)
1091# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1092#elif defined(MFC_OpenMP)
1093# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1094!$omp target enter data map(always,alloc:beta_coef_z)
1095# 163 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1096#endif
1097# 165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1098
1099 call s_compute_weno_coefficients(3, is3_weno)
1100
1101#ifdef MFC_DEBUG
1102# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1103 block
1104# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1105 use iso_fortran_env, only: output_unit
1106# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1107
1108# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1109 print *, 'm_weno.fpp:168: ', '@:ALLOCATE(v_rs_ws_z(is3_weno%beg:is3_weno%end, is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, 1:sys_size))'
1110# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1111
1112# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1113 call flush (output_unit)
1114# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1115 end block
1116# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1117#endif
1118# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1119 allocate (v_rs_ws_z(is3_weno%beg:is3_weno%end, is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, 1:sys_size))
1120# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1121
1122# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1123
1124# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1125#if defined(MFC_OpenACC)
1126# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1127!$acc enter data create(v_rs_ws_z)
1128# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1129#elif defined(MFC_OpenMP)
1130# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1131!$omp target enter data map(always,alloc:v_rs_ws_z)
1132# 168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1133#endif
1134
1135 end subroutine s_initialize_weno_module
1136
1137 !> Compute WENO polynomial coefficients, ideal weights, and smoothness indicators for a given direction
1138 subroutine s_compute_weno_coefficients(weno_dir, is)
1139
1140 ! Compute WENO coefficients for a given coordinate direction. Shu (1997)
1141
1142 integer, intent(in) :: weno_dir
1143 type(int_bounds_info), intent(in) :: is
1144 integer :: s
1145 real(wp), pointer, dimension(:) :: s_cb => null() !< Cell-boundary locations in the s-direction
1146 type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction
1147 integer :: i !< Generic loop iterator
1148 real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil
1149 real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil
1150
1151 ! Determine cell count, boundary locations, and BCs for selected WENO direction
1152
1153 if (weno_dir == 1) then
1154 s = m; s_cb => x_cb; bc_s = bc_x
1155 else if (weno_dir == 2) then
1156 s = n; s_cb => y_cb; bc_s = bc_y
1157 else
1158 s = p; s_cb => z_cb; bc_s = bc_z
1159 end if
1160
1161# 197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1162 ! Computing WENO3 Coefficients
1163 if (weno_dir == 1) then
1164 if (weno_order == 3) then
1165 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1166 ! Polynomial reconstruction coefficients
1167 poly_coef_cbr_x(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1168 poly_coef_cbr_x(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1169
1170 poly_coef_cbl_x(i + 1, 0, 0) = -poly_coef_cbr_x(i + 1, 0, 0)
1171 poly_coef_cbl_x(i + 1, 1, 0) = -poly_coef_cbr_x(i + 1, 1, 0)
1172
1173 ! Ideal (linear) weights
1174 d_cbr_x(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1175 d_cbl_x(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1176
1177 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1)
1178 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1)
1179
1180 ! Smoothness indicator coefficients
1181 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
1182 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
1183 end do
1184
1185 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1186 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1187 if (null_weights) then
1188 if (bc_s%beg == bc_riemann_extrap) then
1189 d_cbr_x(1, 0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1190 d_cbl_x(1, 0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1191 end if
1192
1193 if (bc_s%end == bc_riemann_extrap) then
1194 d_cbr_x(0, s) = 0._wp; d_cbr_x(1, s) = 1._wp
1195 d_cbl_x(0, s) = 0._wp; d_cbl_x(1, s) = 1._wp
1196 end if
1197 end if
1198 ! END: Computing WENO3 Coefficients
1199
1200 ! Computing WENO5 Coefficients
1201 else if (weno_order == 5) then
1202 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1203 ! Polynomial reconstruction coefficients
1204 poly_coef_cbr_x(i + 1, 0, &
1205 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1206 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1207 poly_coef_cbr_x(i + 1, 1, &
1208 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1209 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1210 poly_coef_cbr_x(i + 1, 1, &
1211 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1212 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1213 poly_coef_cbr_x(i + 1, 2, &
1214 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1215 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1216 poly_coef_cbl_x(i + 1, 0, &
1217 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1218 & *(s_cb(i + 3) - s_cb(i + 1)))
1219 poly_coef_cbl_x(i + 1, 1, &
1220 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1221 & + 2))*(s_cb(i) - s_cb(i + 2)))
1222 poly_coef_cbl_x(i + 1, 1, &
1223 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1224 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1225 poly_coef_cbl_x(i + 1, 2, &
1226 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1227 & *(s_cb(i - 2) - s_cb(i + 1)))
1228
1229 poly_coef_cbr_x(i + 1, 0, &
1230 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1231 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1232 poly_coef_cbr_x(i + 1, 2, &
1233 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1234 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1235 poly_coef_cbl_x(i + 1, 0, &
1236 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1237 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1238 poly_coef_cbl_x(i + 1, 2, &
1239 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1240 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1241
1242 ! Ideal (linear) weights
1243 d_cbr_x(0, &
1244 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1245 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1246 d_cbr_x(2, &
1247 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1248 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1249 d_cbl_x(0, &
1250 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1251 & *(s_cb(i + 3) - s_cb(i - 1)))
1252 d_cbl_x(2, &
1253 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1254 & *(s_cb(i - 2) - s_cb(i + 3)))
1255
1256 d_cbr_x(1, i + 1) = 1._wp - d_cbr_x(0, i + 1) - d_cbr_x(2, i + 1)
1257 d_cbl_x(1, i + 1) = 1._wp - d_cbl_x(0, i + 1) - d_cbl_x(2, i + 1)
1258
1259 ! Smoothness indicator coefficients
1260 beta_coef_x(i + 1, 0, &
1261 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1262 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1263 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1264
1265 beta_coef_x(i + 1, 0, &
1266 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1267 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1268 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1269 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1270
1271 beta_coef_x(i + 1, 0, &
1272 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1273 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1274 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1275 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1276
1277 beta_coef_x(i + 1, 1, &
1278 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1279 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1280 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1281
1282 beta_coef_x(i + 1, 1, &
1283 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1284 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1285 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1286 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1287
1288 beta_coef_x(i + 1, 1, &
1289 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1290 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1291 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1292
1293 beta_coef_x(i + 1, 2, &
1294 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1295 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1296 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1297 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1298
1299 beta_coef_x(i + 1, 2, &
1300 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1301 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1302 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1303 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1304
1305 beta_coef_x(i + 1, 2, &
1306 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1307 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1308 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1309 end do
1310
1311 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1312 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1313 if (null_weights) then
1314 if (bc_s%beg == bc_riemann_extrap) then
1315 d_cbr_x(1:2,0) = 0._wp; d_cbr_x(0, 0) = 1._wp
1316 d_cbl_x(1:2,0) = 0._wp; d_cbl_x(0, 0) = 1._wp
1317 d_cbr_x(2, 1) = 0._wp; d_cbr_x(:,1) = d_cbr_x(:,1)/sum(d_cbr_x(:,1))
1318 d_cbl_x(2, 1) = 0._wp; d_cbl_x(:,1) = d_cbl_x(:,1)/sum(d_cbl_x(:,1))
1319 end if
1320
1321 if (bc_s%end == bc_riemann_extrap) then
1322 d_cbr_x(0, s - 1) = 0._wp; d_cbr_x(:,s - 1) = d_cbr_x(:, &
1323 & s - 1)/sum(d_cbr_x(:,s - 1))
1324 d_cbl_x(0, s - 1) = 0._wp; d_cbl_x(:,s - 1) = d_cbl_x(:, &
1325 & s - 1)/sum(d_cbl_x(:,s - 1))
1326 d_cbr_x(0:1,s) = 0._wp; d_cbr_x(2, s) = 1._wp
1327 d_cbl_x(0:1,s) = 0._wp; d_cbl_x(2, s) = 1._wp
1328 end if
1329 end if
1330 else ! WENO7
1331 if (.not. teno) then
1332 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1333 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1334 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1335 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1336 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1337 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1338 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1339 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1340 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1341 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1342 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1343 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1344
1345 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1346 d_cbr_x(0, &
1347 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1348 & *(w(1) - w(8)))
1349 d_cbr_x(1, &
1350 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1351 & *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) &
1352 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1353 & *(w(2) - w(8)))
1354 d_cbr_x(2, &
1355 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1356 & *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) &
1357 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1358 & *(w(3) - w(8)))
1359 d_cbr_x(3, &
1360 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1361 & *(w(3) - w(8)))
1362
1363 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
1364 d_cbl_x(0, &
1365 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
1366 & *(w(3) - w(8)))
1367 d_cbl_x(1, &
1368 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
1369 & *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) &
1370 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
1371 & *(w(3) - w(8)))
1372 d_cbl_x(2, &
1373 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1374 & *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) &
1375 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
1376 & *(w(2) - w(8)))
1377 d_cbl_x(3, &
1378 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1379 & *(w(1) - w(8)))
1380 ! Note: Left has the reversed order of both points and coefficients compared to the right
1381
1382 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1383 poly_coef_cbr_x(i + 1, 0, &
1384 & 0) = (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_cbr_x(i + 1, 0, &
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_cbr_x(i + 1, 0, &
1391 & 2) = (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:i + 3) - s_cb(i - 1:i + 2)
1396 poly_coef_cbr_x(i + 1, 1, &
1397 & 0) = -(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_cbr_x(i + 1, 1, &
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_cbr_x(i + 1, 1, &
1404 & 2) = (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 - 1:i + 2) - s_cb(i - 2:i + 1)
1408 poly_coef_cbr_x(i + 1, 2, &
1409 & 0) = (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_cbr_x(i + 1, 2, &
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_cbr_x(i + 1, 2, &
1416 & 2) = -(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 - 2:i + 1) - s_cb(i - 3:i)
1420 poly_coef_cbr_x(i + 1, 3, &
1421 & 0) = (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_cbr_x(i + 1, 3, &
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_cbr_x(i + 1, 3, &
1430 & 2) = (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 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
1434 poly_coef_cbl_x(i + 1, 3, &
1435 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1436 & + y(2) + y(3) + y(4)))
1437 poly_coef_cbl_x(i + 1, 3, &
1438 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
1439 & + 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) &
1440 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1441 poly_coef_cbl_x(i + 1, 3, &
1442 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
1443 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
1444 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
1445
1446 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
1447 poly_coef_cbl_x(i + 1, 2, &
1448 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
1449 & + y(2) + y(3) + y(4)))
1450 poly_coef_cbl_x(i + 1, 2, &
1451 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
1452 & + 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) &
1453 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1454 poly_coef_cbl_x(i + 1, 2, &
1455 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1456 & + y(2) + y(3) + y(4)))
1457
1458 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
1459 poly_coef_cbl_x(i + 1, 1, &
1460 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
1461 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
1462 poly_coef_cbl_x(i + 1, 1, &
1463 & 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 &
1464 & + 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) &
1465 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1466 poly_coef_cbl_x(i + 1, 1, &
1467 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
1468 & + y(2) + y(3) + y(4)))
1469
1470 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
1471 poly_coef_cbl_x(i + 1, 0, &
1472 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
1473 & + 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) &
1474 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
1475 poly_coef_cbl_x(i + 1, 0, &
1476 & 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) &
1477 & + 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)) &
1478 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1479 & + y(4)))
1480 poly_coef_cbl_x(i + 1, 0, &
1481 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
1482 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
1483
1484 poly_coef_cbl_x(i + 1,:,:) = -poly_coef_cbl_x(i + 1,:,:)
1485 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
1486
1487 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
1488 beta_coef_x(i + 1, 3, &
1489 & 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) &
1490 & + 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) &
1491 & **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 &
1492 & + 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) &
1493 & *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) &
1494 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
1495 & + 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) &
1496 & *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) &
1497 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
1498 & **2*(y(1) + y(2) + y(3) + y(4))**2)
1499 beta_coef_x(i + 1, 3, &
1500 & 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) &
1501 & **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) &
1502 & + 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) &
1503 & + 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) &
1504 & + 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) &
1505 & *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) &
1506 & *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) &
1507 & *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) &
1508 & **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) &
1509 & **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) &
1510 & *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) &
1511 & + 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) &
1512 & *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) &
1513 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
1514 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
1515 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1516 beta_coef_x(i + 1, 3, &
1517 & 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) &
1518 & **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) &
1519 & + 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) &
1520 & *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 &
1521 & + 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) &
1522 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
1523 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1524 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1525 beta_coef_x(i + 1, 3, &
1526 & 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 &
1527 & + 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 &
1528 & + 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 &
1529 & + 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) &
1530 & + 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) &
1531 & **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) &
1532 & **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) &
1533 & **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) &
1534 & **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) &
1535 & *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) &
1536 & **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) &
1537 & **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) &
1538 & **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) &
1539 & **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) &
1540 & **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) &
1541 & **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) &
1542 & **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) &
1543 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
1544 & + 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 &
1545 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
1546 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
1547 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1548 & + y(3) + y(4))**2)
1549 beta_coef_x(i + 1, 3, &
1550 & 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) &
1551 & **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) &
1552 & **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) &
1553 & **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) &
1554 & *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) &
1555 & *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) &
1556 & **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) &
1557 & **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) &
1558 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
1559 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
1560 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
1561 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
1562 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1563 beta_coef_x(i + 1, 3, &
1564 & 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 &
1565 & + 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) &
1566 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
1567 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
1568 & + y(4))**2)
1569
1570 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
1571 beta_coef_x(i + 1, 2, &
1572 & 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 &
1573 & + 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) &
1574 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
1575 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
1576 & + y(4))**2)
1577 beta_coef_x(i + 1, 2, &
1578 & 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 &
1579 & + 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) &
1580 & - 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 &
1581 & - 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 &
1582 & + 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 &
1583 & + 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 &
1584 & + 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 &
1585 & + 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) &
1586 & **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 &
1587 & - 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 &
1588 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
1589 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
1590 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
1591 & **2)
1592 beta_coef_x(i + 1, 2, &
1593 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
1594 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
1595 & + 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) &
1596 & *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)) &
1597 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1598 & + y(4))**2)
1599 beta_coef_x(i + 1, 2, &
1600 & 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 &
1601 & + 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 &
1602 & + 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 &
1603 & + 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) &
1604 & + 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) &
1605 & **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) &
1606 & **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) &
1607 & **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) &
1608 & **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) &
1609 & *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 &
1610 & + 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) &
1611 & **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 &
1612 & + 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 &
1613 & + 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) &
1614 & **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) &
1615 & *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) &
1616 & + 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 &
1617 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
1618 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
1619 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
1620 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1621 & + y(3) + y(4))**2)
1622 beta_coef_x(i + 1, 2, &
1623 & 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) &
1624 & **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) &
1625 & *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) &
1626 & *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) &
1627 & *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) &
1628 & **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) &
1629 & **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) &
1630 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
1631 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
1632 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
1633 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
1634 & **2)
1635 beta_coef_x(i + 1, 2, &
1636 & 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 &
1637 & - 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)) &
1638 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
1639
1640 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
1641 beta_coef_x(i + 1, 1, &
1642 & 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 &
1643 & - 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)) &
1644 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1645 beta_coef_x(i + 1, 1, &
1646 & 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) &
1647 & *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) &
1648 & **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) &
1649 & **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) &
1650 & **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) &
1651 & **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) &
1652 & **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) &
1653 & *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) &
1654 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
1655 & **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) &
1656 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1657 & + y(3) + y(4))**2)
1658 beta_coef_x(i + 1, 1, &
1659 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
1660 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
1661 & + 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) &
1662 & *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)) &
1663 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1664 & + y(4))**2)
1665 beta_coef_x(i + 1, 1, &
1666 & 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) &
1667 & + 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) &
1668 & **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) &
1669 & **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) &
1670 & **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) &
1671 & **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) &
1672 & + 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) &
1673 & **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) &
1674 & **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) &
1675 & **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) &
1676 & **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) &
1677 & - 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) &
1678 & **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) &
1679 & **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) &
1680 & *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) &
1681 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
1682 & **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) &
1683 & **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) &
1684 & **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) &
1685 & **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) &
1686 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1687 beta_coef_x(i + 1, 1, &
1688 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
1689 & **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) &
1690 & **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) &
1691 & *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) &
1692 & + 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) &
1693 & **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) &
1694 & **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) &
1695 & **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) &
1696 & **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 &
1697 & - 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 &
1698 & - 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) &
1699 & **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) &
1700 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1701 beta_coef_x(i + 1, 1, &
1702 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
1703 & **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 &
1704 & + 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) &
1705 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1706 & + y(3) + y(4))**2)
1707
1708 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
1709 beta_coef_x(i + 1, 0, &
1710 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
1711 & **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 &
1712 & + 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) &
1713 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
1714 & + y(3) + y(4))**2)
1715 beta_coef_x(i + 1, 0, &
1716 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
1717 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
1718 & **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) &
1719 & **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) &
1720 & + 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) &
1721 & **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 &
1722 & + 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) &
1723 & **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) &
1724 & *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 &
1725 & + 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) &
1726 & + 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) &
1727 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
1728 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1729 beta_coef_x(i + 1, 0, &
1730 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
1731 & *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) &
1732 & + 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) &
1733 & **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) &
1734 & + 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) &
1735 & *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) &
1736 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
1737 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
1738 beta_coef_x(i + 1, 0, &
1739 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
1740 & **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) &
1741 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
1742 & + 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) &
1743 & + 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) &
1744 & *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) &
1745 & *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) &
1746 & + 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) &
1747 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
1748 & + 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) &
1749 & **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) &
1750 & **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) &
1751 & *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) &
1752 & **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) &
1753 & **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 &
1754 & + 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) &
1755 & + 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 &
1756 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
1757 & + 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) &
1758 & **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) &
1759 & **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) &
1760 & **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)) &
1761 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
1762 beta_coef_x(i + 1, 0, &
1763 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
1764 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
1765 & **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) &
1766 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
1767 & **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) &
1768 & **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) &
1769 & **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) &
1770 & + 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) &
1771 & + 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) &
1772 & + 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) &
1773 & *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 &
1774 & + 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) &
1775 & *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) &
1776 & + 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) &
1777 & **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)) &
1778 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
1779 & + y(4))**2)
1780 beta_coef_x(i + 1, 0, &
1781 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
1782 & **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) &
1783 & + 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) &
1784 & *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 &
1785 & + 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) &
1786 & **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) &
1787 & + 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) &
1788 & **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) &
1789 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
1790 & + y(3) + y(4))**2)
1791 end do
1792 else ! TENO (only supports uniform grid)
1793 ! (Fu, et al., 2016) Table 2 (for right flux)
1794 d_cbl_x(0,:) = 18._wp/35._wp
1795 d_cbl_x(1,:) = 3._wp/35._wp
1796 d_cbl_x(2,:) = 9._wp/35._wp
1797 d_cbl_x(3,:) = 1._wp/35._wp
1798 d_cbl_x(4,:) = 4._wp/35._wp
1799
1800 d_cbr_x(0,:) = 18._wp/35._wp
1801 d_cbr_x(1,:) = 9._wp/35._wp
1802 d_cbr_x(2,:) = 3._wp/35._wp
1803 d_cbr_x(3,:) = 4._wp/35._wp
1804 d_cbr_x(4,:) = 1._wp/35._wp
1805 end if
1806 end if
1807 end if
1808# 197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
1809 ! Computing WENO3 Coefficients
1810 if (weno_dir == 2) then
1811 if (weno_order == 3) then
1812 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1813 ! Polynomial reconstruction coefficients
1814 poly_coef_cbr_y(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
1815 poly_coef_cbr_y(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
1816
1817 poly_coef_cbl_y(i + 1, 0, 0) = -poly_coef_cbr_y(i + 1, 0, 0)
1818 poly_coef_cbl_y(i + 1, 1, 0) = -poly_coef_cbr_y(i + 1, 1, 0)
1819
1820 ! Ideal (linear) weights
1821 d_cbr_y(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
1822 d_cbl_y(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
1823
1824 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1)
1825 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1)
1826
1827 ! Smoothness indicator coefficients
1828 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
1829 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
1830 end do
1831
1832 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1833 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1834 if (null_weights) then
1835 if (bc_s%beg == bc_riemann_extrap) then
1836 d_cbr_y(1, 0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1837 d_cbl_y(1, 0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1838 end if
1839
1840 if (bc_s%end == bc_riemann_extrap) then
1841 d_cbr_y(0, s) = 0._wp; d_cbr_y(1, s) = 1._wp
1842 d_cbl_y(0, s) = 0._wp; d_cbl_y(1, s) = 1._wp
1843 end if
1844 end if
1845 ! END: Computing WENO3 Coefficients
1846
1847 ! Computing WENO5 Coefficients
1848 else if (weno_order == 5) then
1849 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1850 ! Polynomial reconstruction coefficients
1851 poly_coef_cbr_y(i + 1, 0, &
1852 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
1853 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
1854 poly_coef_cbr_y(i + 1, 1, &
1855 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
1856 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
1857 poly_coef_cbr_y(i + 1, 1, &
1858 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
1859 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1860 poly_coef_cbr_y(i + 1, 2, &
1861 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1862 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
1863 poly_coef_cbl_y(i + 1, 0, &
1864 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
1865 & *(s_cb(i + 3) - s_cb(i + 1)))
1866 poly_coef_cbl_y(i + 1, 1, &
1867 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
1868 & + 2))*(s_cb(i) - s_cb(i + 2)))
1869 poly_coef_cbl_y(i + 1, 1, &
1870 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
1871 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
1872 poly_coef_cbl_y(i + 1, 2, &
1873 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
1874 & *(s_cb(i - 2) - s_cb(i + 1)))
1875
1876 poly_coef_cbr_y(i + 1, 0, &
1877 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
1878 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
1879 poly_coef_cbr_y(i + 1, 2, &
1880 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
1881 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
1882 poly_coef_cbl_y(i + 1, 0, &
1883 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
1884 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
1885 poly_coef_cbl_y(i + 1, 2, &
1886 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
1887 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
1888
1889 ! Ideal (linear) weights
1890 d_cbr_y(0, &
1891 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
1892 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
1893 d_cbr_y(2, &
1894 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
1895 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
1896 d_cbl_y(0, &
1897 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
1898 & *(s_cb(i + 3) - s_cb(i - 1)))
1899 d_cbl_y(2, &
1900 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
1901 & *(s_cb(i - 2) - s_cb(i + 3)))
1902
1903 d_cbr_y(1, i + 1) = 1._wp - d_cbr_y(0, i + 1) - d_cbr_y(2, i + 1)
1904 d_cbl_y(1, i + 1) = 1._wp - d_cbl_y(0, i + 1) - d_cbl_y(2, i + 1)
1905
1906 ! Smoothness indicator coefficients
1907 beta_coef_y(i + 1, 0, &
1908 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1909 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1910 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
1911
1912 beta_coef_y(i + 1, 0, &
1913 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1914 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
1915 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
1916 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
1917
1918 beta_coef_y(i + 1, 0, &
1919 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1920 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
1921 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
1922 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
1923
1924 beta_coef_y(i + 1, 1, &
1925 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1926 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1927 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
1928
1929 beta_coef_y(i + 1, 1, &
1930 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
1931 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
1932 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
1933 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
1934
1935 beta_coef_y(i + 1, 1, &
1936 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1937 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
1938 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
1939
1940 beta_coef_y(i + 1, 2, &
1941 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1942 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
1943 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
1944 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
1945
1946 beta_coef_y(i + 1, 2, &
1947 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1948 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
1949 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
1950 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
1951
1952 beta_coef_y(i + 1, 2, &
1953 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
1954 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
1955 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
1956 end do
1957
1958 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
1959 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
1960 if (null_weights) then
1961 if (bc_s%beg == bc_riemann_extrap) then
1962 d_cbr_y(1:2,0) = 0._wp; d_cbr_y(0, 0) = 1._wp
1963 d_cbl_y(1:2,0) = 0._wp; d_cbl_y(0, 0) = 1._wp
1964 d_cbr_y(2, 1) = 0._wp; d_cbr_y(:,1) = d_cbr_y(:,1)/sum(d_cbr_y(:,1))
1965 d_cbl_y(2, 1) = 0._wp; d_cbl_y(:,1) = d_cbl_y(:,1)/sum(d_cbl_y(:,1))
1966 end if
1967
1968 if (bc_s%end == bc_riemann_extrap) then
1969 d_cbr_y(0, s - 1) = 0._wp; d_cbr_y(:,s - 1) = d_cbr_y(:, &
1970 & s - 1)/sum(d_cbr_y(:,s - 1))
1971 d_cbl_y(0, s - 1) = 0._wp; d_cbl_y(:,s - 1) = d_cbl_y(:, &
1972 & s - 1)/sum(d_cbl_y(:,s - 1))
1973 d_cbr_y(0:1,s) = 0._wp; d_cbr_y(2, s) = 1._wp
1974 d_cbl_y(0:1,s) = 0._wp; d_cbl_y(2, s) = 1._wp
1975 end if
1976 end if
1977 else ! WENO7
1978 if (.not. teno) then
1979 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
1980 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
1981 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
1982 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
1983 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
1984 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
1985 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
1986 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
1987 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
1988 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
1989 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
1990 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
1991
1992 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
1993 d_cbr_y(0, &
1994 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
1995 & *(w(1) - w(8)))
1996 d_cbr_y(1, &
1997 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
1998 & *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) &
1999 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2000 & *(w(2) - w(8)))
2001 d_cbr_y(2, &
2002 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2003 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
2004 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2005 & *(w(3) - w(8)))
2006 d_cbr_y(3, &
2007 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2008 & *(w(3) - w(8)))
2009
2010 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
2011 d_cbl_y(0, &
2012 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2013 & *(w(3) - w(8)))
2014 d_cbl_y(1, &
2015 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2016 & *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) &
2017 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2018 & *(w(3) - w(8)))
2019 d_cbl_y(2, &
2020 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2021 & *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) &
2022 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2023 & *(w(2) - w(8)))
2024 d_cbl_y(3, &
2025 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2026 & *(w(1) - w(8)))
2027 ! Note: Left has the reversed order of both points and coefficients compared to the right
2028
2029 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2030 poly_coef_cbr_y(i + 1, 0, &
2031 & 0) = (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_cbr_y(i + 1, 0, &
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_cbr_y(i + 1, 0, &
2038 & 2) = (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:i + 3) - s_cb(i - 1:i + 2)
2043 poly_coef_cbr_y(i + 1, 1, &
2044 & 0) = -(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_cbr_y(i + 1, 1, &
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_cbr_y(i + 1, 1, &
2051 & 2) = (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 - 1:i + 2) - s_cb(i - 2:i + 1)
2055 poly_coef_cbr_y(i + 1, 2, &
2056 & 0) = (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_cbr_y(i + 1, 2, &
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_cbr_y(i + 1, 2, &
2063 & 2) = -(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 - 2:i + 1) - s_cb(i - 3:i)
2067 poly_coef_cbr_y(i + 1, 3, &
2068 & 0) = (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_cbr_y(i + 1, 3, &
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_cbr_y(i + 1, 3, &
2077 & 2) = (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 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2081 poly_coef_cbl_y(i + 1, 3, &
2082 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2083 & + y(2) + y(3) + y(4)))
2084 poly_coef_cbl_y(i + 1, 3, &
2085 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2086 & + 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) &
2087 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2088 poly_coef_cbl_y(i + 1, 3, &
2089 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2090 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2091 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2092
2093 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2094 poly_coef_cbl_y(i + 1, 2, &
2095 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2096 & + y(2) + y(3) + y(4)))
2097 poly_coef_cbl_y(i + 1, 2, &
2098 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2099 & + 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) &
2100 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2101 poly_coef_cbl_y(i + 1, 2, &
2102 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2103 & + y(2) + y(3) + y(4)))
2104
2105 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2106 poly_coef_cbl_y(i + 1, 1, &
2107 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2108 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2109 poly_coef_cbl_y(i + 1, 1, &
2110 & 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 &
2111 & + 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) &
2112 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2113 poly_coef_cbl_y(i + 1, 1, &
2114 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2115 & + y(2) + y(3) + y(4)))
2116
2117 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2118 poly_coef_cbl_y(i + 1, 0, &
2119 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2120 & + 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) &
2121 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2122 poly_coef_cbl_y(i + 1, 0, &
2123 & 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) &
2124 & + 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)) &
2125 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2126 & + y(4)))
2127 poly_coef_cbl_y(i + 1, 0, &
2128 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2129 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2130
2131 poly_coef_cbl_y(i + 1,:,:) = -poly_coef_cbl_y(i + 1,:,:)
2132 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2133
2134 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2135 beta_coef_y(i + 1, 3, &
2136 & 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) &
2137 & + 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) &
2138 & **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 &
2139 & + 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) &
2140 & *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) &
2141 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2142 & + 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) &
2143 & *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) &
2144 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2145 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2146 beta_coef_y(i + 1, 3, &
2147 & 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) &
2148 & **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) &
2149 & + 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) &
2150 & + 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) &
2151 & + 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) &
2152 & *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) &
2153 & *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) &
2154 & *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) &
2155 & **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) &
2156 & **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) &
2157 & *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) &
2158 & + 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) &
2159 & *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) &
2160 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2161 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2162 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2163 beta_coef_y(i + 1, 3, &
2164 & 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) &
2165 & **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) &
2166 & + 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) &
2167 & *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 &
2168 & + 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) &
2169 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2170 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2171 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2172 beta_coef_y(i + 1, 3, &
2173 & 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 &
2174 & + 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 &
2175 & + 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 &
2176 & + 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) &
2177 & + 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) &
2178 & **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) &
2179 & **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) &
2180 & **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) &
2181 & **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) &
2182 & *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) &
2183 & **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) &
2184 & **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) &
2185 & **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) &
2186 & **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) &
2187 & **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) &
2188 & **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) &
2189 & **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) &
2190 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2191 & + 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 &
2192 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2193 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2194 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2195 & + y(3) + y(4))**2)
2196 beta_coef_y(i + 1, 3, &
2197 & 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) &
2198 & **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) &
2199 & **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) &
2200 & **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) &
2201 & *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) &
2202 & *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) &
2203 & **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) &
2204 & **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) &
2205 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2206 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2207 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2208 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2209 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2210 beta_coef_y(i + 1, 3, &
2211 & 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 &
2212 & + 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) &
2213 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2214 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2215 & + y(4))**2)
2216
2217 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2218 beta_coef_y(i + 1, 2, &
2219 & 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 &
2220 & + 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) &
2221 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2222 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2223 & + y(4))**2)
2224 beta_coef_y(i + 1, 2, &
2225 & 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 &
2226 & + 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) &
2227 & - 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 &
2228 & - 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 &
2229 & + 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 &
2230 & + 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 &
2231 & + 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 &
2232 & + 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) &
2233 & **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 &
2234 & - 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 &
2235 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2236 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2237 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2238 & **2)
2239 beta_coef_y(i + 1, 2, &
2240 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2241 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2242 & + 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) &
2243 & *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)) &
2244 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2245 & + y(4))**2)
2246 beta_coef_y(i + 1, 2, &
2247 & 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 &
2248 & + 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 &
2249 & + 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 &
2250 & + 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) &
2251 & + 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) &
2252 & **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) &
2253 & **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) &
2254 & **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) &
2255 & **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) &
2256 & *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 &
2257 & + 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) &
2258 & **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 &
2259 & + 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 &
2260 & + 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) &
2261 & **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) &
2262 & *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) &
2263 & + 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 &
2264 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2265 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2266 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2267 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2268 & + y(3) + y(4))**2)
2269 beta_coef_y(i + 1, 2, &
2270 & 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) &
2271 & **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) &
2272 & *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) &
2273 & *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) &
2274 & *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) &
2275 & **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) &
2276 & **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) &
2277 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2278 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2279 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2280 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2281 & **2)
2282 beta_coef_y(i + 1, 2, &
2283 & 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 &
2284 & - 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)) &
2285 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2286
2287 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2288 beta_coef_y(i + 1, 1, &
2289 & 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 &
2290 & - 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)) &
2291 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2292 beta_coef_y(i + 1, 1, &
2293 & 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) &
2294 & *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) &
2295 & **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) &
2296 & **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) &
2297 & **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) &
2298 & **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) &
2299 & **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) &
2300 & *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) &
2301 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2302 & **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) &
2303 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2304 & + y(3) + y(4))**2)
2305 beta_coef_y(i + 1, 1, &
2306 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2307 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2308 & + 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) &
2309 & *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)) &
2310 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2311 & + y(4))**2)
2312 beta_coef_y(i + 1, 1, &
2313 & 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) &
2314 & + 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) &
2315 & **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) &
2316 & **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) &
2317 & **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) &
2318 & **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) &
2319 & + 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) &
2320 & **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) &
2321 & **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) &
2322 & **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) &
2323 & **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) &
2324 & - 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) &
2325 & **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) &
2326 & **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) &
2327 & *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) &
2328 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2329 & **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) &
2330 & **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) &
2331 & **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) &
2332 & **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) &
2333 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2334 beta_coef_y(i + 1, 1, &
2335 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2336 & **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) &
2337 & **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) &
2338 & *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) &
2339 & + 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) &
2340 & **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) &
2341 & **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) &
2342 & **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) &
2343 & **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 &
2344 & - 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 &
2345 & - 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) &
2346 & **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) &
2347 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2348 beta_coef_y(i + 1, 1, &
2349 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2350 & **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 &
2351 & + 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) &
2352 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2353 & + y(3) + y(4))**2)
2354
2355 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2356 beta_coef_y(i + 1, 0, &
2357 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
2358 & **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 &
2359 & + 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) &
2360 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2361 & + y(3) + y(4))**2)
2362 beta_coef_y(i + 1, 0, &
2363 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
2364 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
2365 & **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) &
2366 & **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) &
2367 & + 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) &
2368 & **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 &
2369 & + 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) &
2370 & **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) &
2371 & *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 &
2372 & + 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) &
2373 & + 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) &
2374 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2375 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2376 beta_coef_y(i + 1, 0, &
2377 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
2378 & *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) &
2379 & + 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) &
2380 & **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) &
2381 & + 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) &
2382 & *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) &
2383 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
2384 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2385 beta_coef_y(i + 1, 0, &
2386 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
2387 & **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) &
2388 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
2389 & + 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) &
2390 & + 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) &
2391 & *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) &
2392 & *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) &
2393 & + 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) &
2394 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
2395 & + 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) &
2396 & **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) &
2397 & **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) &
2398 & *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) &
2399 & **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) &
2400 & **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 &
2401 & + 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) &
2402 & + 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 &
2403 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
2404 & + 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) &
2405 & **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) &
2406 & **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) &
2407 & **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)) &
2408 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2409 beta_coef_y(i + 1, 0, &
2410 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
2411 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
2412 & **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) &
2413 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
2414 & **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) &
2415 & **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) &
2416 & **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) &
2417 & + 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) &
2418 & + 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) &
2419 & + 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) &
2420 & *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 &
2421 & + 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) &
2422 & *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) &
2423 & + 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) &
2424 & **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)) &
2425 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2426 & + y(4))**2)
2427 beta_coef_y(i + 1, 0, &
2428 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
2429 & **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) &
2430 & + 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) &
2431 & *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 &
2432 & + 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) &
2433 & **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) &
2434 & + 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) &
2435 & **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) &
2436 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
2437 & + y(3) + y(4))**2)
2438 end do
2439 else ! TENO (only supports uniform grid)
2440 ! (Fu, et al., 2016) Table 2 (for right flux)
2441 d_cbl_y(0,:) = 18._wp/35._wp
2442 d_cbl_y(1,:) = 3._wp/35._wp
2443 d_cbl_y(2,:) = 9._wp/35._wp
2444 d_cbl_y(3,:) = 1._wp/35._wp
2445 d_cbl_y(4,:) = 4._wp/35._wp
2446
2447 d_cbr_y(0,:) = 18._wp/35._wp
2448 d_cbr_y(1,:) = 9._wp/35._wp
2449 d_cbr_y(2,:) = 3._wp/35._wp
2450 d_cbr_y(3,:) = 4._wp/35._wp
2451 d_cbr_y(4,:) = 1._wp/35._wp
2452 end if
2453 end if
2454 end if
2455# 197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
2456 ! Computing WENO3 Coefficients
2457 if (weno_dir == 3) then
2458 if (weno_order == 3) then
2459 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2460 ! Polynomial reconstruction coefficients
2461 poly_coef_cbr_z(i + 1, 0, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i) - s_cb(i + 2))
2462 poly_coef_cbr_z(i + 1, 1, 0) = (s_cb(i) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 1))
2463
2464 poly_coef_cbl_z(i + 1, 0, 0) = -poly_coef_cbr_z(i + 1, 0, 0)
2465 poly_coef_cbl_z(i + 1, 1, 0) = -poly_coef_cbr_z(i + 1, 1, 0)
2466
2467 ! Ideal (linear) weights
2468 d_cbr_z(0, i + 1) = (s_cb(i - 1) - s_cb(i + 1))/(s_cb(i - 1) - s_cb(i + 2))
2469 d_cbl_z(0, i + 1) = (s_cb(i - 1) - s_cb(i))/(s_cb(i - 1) - s_cb(i + 2))
2470
2471 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1)
2472 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1)
2473
2474 ! Smoothness indicator coefficients
2475 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
2476 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
2477 end do
2478
2479 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2480 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2481 if (null_weights) then
2482 if (bc_s%beg == bc_riemann_extrap) then
2483 d_cbr_z(1, 0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2484 d_cbl_z(1, 0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2485 end if
2486
2487 if (bc_s%end == bc_riemann_extrap) then
2488 d_cbr_z(0, s) = 0._wp; d_cbr_z(1, s) = 1._wp
2489 d_cbl_z(0, s) = 0._wp; d_cbl_z(1, s) = 1._wp
2490 end if
2491 end if
2492 ! END: Computing WENO3 Coefficients
2493
2494 ! Computing WENO5 Coefficients
2495 else if (weno_order == 5) then
2496 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2497 ! Polynomial reconstruction coefficients
2498 poly_coef_cbr_z(i + 1, 0, &
2499 & 0) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i) - s_cb(i &
2500 & + 3))*(s_cb(i + 3) - s_cb(i + 1)))
2501 poly_coef_cbr_z(i + 1, 1, &
2502 & 0) = ((s_cb(i - 1) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) &
2503 & - s_cb(i + 2))*(s_cb(i + 2) - s_cb(i)))
2504 poly_coef_cbr_z(i + 1, 1, &
2505 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i + 2)))/((s_cb(i - 1) &
2506 & - s_cb(i + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2507 poly_coef_cbr_z(i + 1, 2, &
2508 & 1) = ((s_cb(i) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2509 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1)))
2510 poly_coef_cbl_z(i + 1, 0, &
2511 & 0) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i) - s_cb(i + 3)) &
2512 & *(s_cb(i + 3) - s_cb(i + 1)))
2513 poly_coef_cbl_z(i + 1, 1, &
2514 & 0) = ((s_cb(i) - s_cb(i - 1))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 1) - s_cb(i &
2515 & + 2))*(s_cb(i) - s_cb(i + 2)))
2516 poly_coef_cbl_z(i + 1, 1, &
2517 & 1) = ((s_cb(i + 1) - s_cb(i))*(s_cb(i) - s_cb(i + 2)))/((s_cb(i - 1) - s_cb(i &
2518 & + 1))*(s_cb(i - 1) - s_cb(i + 2)))
2519 poly_coef_cbl_z(i + 1, 2, &
2520 & 1) = ((s_cb(i - 1) - s_cb(i))*(s_cb(i) - s_cb(i + 1)))/((s_cb(i - 2) - s_cb(i)) &
2521 & *(s_cb(i - 2) - s_cb(i + 1)))
2522
2523 poly_coef_cbr_z(i + 1, 0, &
2524 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i) - s_cb(i &
2525 & + 2))*(s_cb(i) - s_cb(i + 3)))*((s_cb(i) - s_cb(i + 1)))
2526 poly_coef_cbr_z(i + 1, 2, &
2527 & 0) = ((s_cb(i - 2) - s_cb(i + 1)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 1) &
2528 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 2)))*((s_cb(i + 1) - s_cb(i)))
2529 poly_coef_cbl_z(i + 1, 0, &
2530 & 1) = ((s_cb(i) - s_cb(i + 2)) + (s_cb(i) - s_cb(i + 3)))/((s_cb(i) - s_cb(i + 2)) &
2531 & *(s_cb(i) - s_cb(i + 3)))*((s_cb(i + 1) - s_cb(i)))
2532 poly_coef_cbl_z(i + 1, 2, &
2533 & 0) = ((s_cb(i - 2) - s_cb(i)) + (s_cb(i - 1) - s_cb(i + 1)))/((s_cb(i - 2) &
2534 & - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))*((s_cb(i) - s_cb(i + 1)))
2535
2536 ! Ideal (linear) weights
2537 d_cbr_z(0, &
2538 & i + 1) = ((s_cb(i - 2) - s_cb(i + 1))*(s_cb(i + 1) - s_cb(i - 1)))/((s_cb(i - 2) &
2539 & - s_cb(i + 3))*(s_cb(i + 3) - s_cb(i - 1)))
2540 d_cbr_z(2, &
2541 & i + 1) = ((s_cb(i + 1) - s_cb(i + 2))*(s_cb(i + 1) - s_cb(i + 3)))/((s_cb(i - 2) &
2542 & - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3)))
2543 d_cbl_z(0, &
2544 & i + 1) = ((s_cb(i - 2) - s_cb(i))*(s_cb(i) - s_cb(i - 1)))/((s_cb(i - 2) - s_cb(i + 3)) &
2545 & *(s_cb(i + 3) - s_cb(i - 1)))
2546 d_cbl_z(2, &
2547 & i + 1) = ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/((s_cb(i - 2) - s_cb(i + 2)) &
2548 & *(s_cb(i - 2) - s_cb(i + 3)))
2549
2550 d_cbr_z(1, i + 1) = 1._wp - d_cbr_z(0, i + 1) - d_cbr_z(2, i + 1)
2551 d_cbl_z(1, i + 1) = 1._wp - d_cbl_z(0, i + 1) - d_cbl_z(2, i + 1)
2552
2553 ! Smoothness indicator coefficients
2554 beta_coef_z(i + 1, 0, &
2555 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2556 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2557 & **2._wp)/((s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp)
2558
2559 beta_coef_z(i + 1, 0, &
2560 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2561 & - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i)) &
2562 & *((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - s_cb(i + 2)) &
2563 & *(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - s_cb(i + 1)))
2564
2565 beta_coef_z(i + 1, 0, &
2566 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2567 & + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) &
2568 & + ((s_cb(i + 2) - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - s_cb(i &
2569 & + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp)
2570
2571 beta_coef_z(i + 1, 1, &
2572 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2573 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2574 & /((s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp)
2575
2576 beta_coef_z(i + 1, 1, &
2577 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - s_cb(i + 1))*((s_cb(i) &
2578 & - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) &
2579 & + (s_cb(i + 1) - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - s_cb(i - 1)) &
2580 & *(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - s_cb(i)))
2581
2582 beta_coef_z(i + 1, 1, &
2583 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2584 & + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1)) &
2585 & **2._wp)/((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 2))**2._wp)
2586
2587 beta_coef_z(i + 1, 2, &
2588 & 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2589 & + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) &
2590 & - s_cb(i - 2)) + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) &
2591 & - s_cb(i + 1))**2._wp*(s_cb(i - 1) - s_cb(i + 1))**2._wp)
2592
2593 beta_coef_z(i + 1, 2, &
2594 & 1) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2595 & + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i &
2596 & - 1))*((s_cb(i) - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) &
2597 & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - s_cb(i - 1)))
2598
2599 beta_coef_z(i + 1, 2, &
2600 & 2) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - s_cb(i))**2._wp &
2601 & + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i))) &
2602 & /((s_cb(i - 2) - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp)
2603 end do
2604
2605 ! Modifying the ideal weights coefficients in the neighborhood of beginning and end Riemann state extrapolation
2606 ! BC to avoid any contributions from outside of the physical domain during the WENO reconstruction
2607 if (null_weights) then
2608 if (bc_s%beg == bc_riemann_extrap) then
2609 d_cbr_z(1:2,0) = 0._wp; d_cbr_z(0, 0) = 1._wp
2610 d_cbl_z(1:2,0) = 0._wp; d_cbl_z(0, 0) = 1._wp
2611 d_cbr_z(2, 1) = 0._wp; d_cbr_z(:,1) = d_cbr_z(:,1)/sum(d_cbr_z(:,1))
2612 d_cbl_z(2, 1) = 0._wp; d_cbl_z(:,1) = d_cbl_z(:,1)/sum(d_cbl_z(:,1))
2613 end if
2614
2615 if (bc_s%end == bc_riemann_extrap) then
2616 d_cbr_z(0, s - 1) = 0._wp; d_cbr_z(:,s - 1) = d_cbr_z(:, &
2617 & s - 1)/sum(d_cbr_z(:,s - 1))
2618 d_cbl_z(0, s - 1) = 0._wp; d_cbl_z(:,s - 1) = d_cbl_z(:, &
2619 & s - 1)/sum(d_cbl_z(:,s - 1))
2620 d_cbr_z(0:1,s) = 0._wp; d_cbr_z(2, s) = 1._wp
2621 d_cbl_z(0:1,s) = 0._wp; d_cbl_z(2, s) = 1._wp
2622 end if
2623 end if
2624 else ! WENO7
2625 if (.not. teno) then
2626 do i = is%beg - 1 + weno_polyn, is%end - 1 - weno_polyn
2627 ! Reference: Shu (1997) "Essentially Non-Oscillatory and Weighted Essentially Non-Oscillatory Schemes
2628 ! for Hyperbolic Conservation Laws" Equation 2.20: Polynomial Coefficients (poly_coef_cb) Equation 2.61:
2629 ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all
2630 ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb)
2631 ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients
2632 ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly.
2633 ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial
2634 ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation
2635 ! and integration of each cross term of the polynomial coefficients, using the cell value differences
2636 ! (dvd) instead of the values themselves. While the polynomial coefficients sum to 1, the derivative of
2637 ! 1 is 0, which means it does not create additional cross terms in the smoothness indicators.
2638
2639 w = s_cb(i - 3:i + 4) - s_cb(i) ! Offset using s_cb(i) to reduce floating point error
2640 d_cbr_z(0, &
2641 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2642 & *(w(1) - w(8)))
2643 d_cbr_z(1, &
2644 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2645 & *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) &
2646 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2647 & *(w(2) - w(8)))
2648 d_cbr_z(2, &
2649 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2650 & *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) &
2651 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2652 & *(w(3) - w(8)))
2653 d_cbr_z(3, &
2654 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2655 & *(w(3) - w(8)))
2656
2657 w = s_cb(i + 4:i - 3:-1) - s_cb(i)
2658 d_cbl_z(0, &
2659 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(3) - w(5)))/((w(1) - w(8))*(w(2) - w(8)) &
2660 & *(w(3) - w(8)))
2661 d_cbl_z(1, &
2662 & i + 1) = ((w(1) - w(5))*(w(2) - w(5))*(w(5) - w(8))*(w(1)*w(2) + w(1)*w(3) + w(2) &
2663 & *w(3) - w(1)*w(7) - w(1)*w(8) - w(2)*w(7) - w(2)*w(8) - w(3)*w(7) - w(3)*w(8) + w(7) &
2664 & *w(8) + w(7)**2 + w(8)**2))/((w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7))*(w(2) - w(8)) &
2665 & *(w(3) - w(8)))
2666 d_cbl_z(2, &
2667 & i + 1) = ((w(1) - w(5))*(w(5) - w(7))*(w(5) - w(8))*(w(1)*w(2) - w(1)*w(6) - w(1) &
2668 & *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) &
2669 & *w(8) + w(1)**2 + w(2)**2))/((w(1) - w(6))*(w(1) - w(7))*(w(1) - w(8))*(w(2) - w(7)) &
2670 & *(w(2) - w(8)))
2671 d_cbl_z(3, &
2672 & i + 1) = ((w(5) - w(6))*(w(5) - w(7))*(w(5) - w(8)))/((w(1) - w(6))*(w(1) - w(7)) &
2673 & *(w(1) - w(8)))
2674 ! Note: Left has the reversed order of both points and coefficients compared to the right
2675
2676 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
2677 poly_coef_cbr_z(i + 1, 0, &
2678 & 0) = (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_cbr_z(i + 1, 0, &
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_cbr_z(i + 1, 0, &
2685 & 2) = (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:i + 3) - s_cb(i - 1:i + 2)
2690 poly_coef_cbr_z(i + 1, 1, &
2691 & 0) = -(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_cbr_z(i + 1, 1, &
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_cbr_z(i + 1, 1, &
2698 & 2) = (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 - 1:i + 2) - s_cb(i - 2:i + 1)
2702 poly_coef_cbr_z(i + 1, 2, &
2703 & 0) = (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_cbr_z(i + 1, 2, &
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_cbr_z(i + 1, 2, &
2710 & 2) = -(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 - 2:i + 1) - s_cb(i - 3:i)
2714 poly_coef_cbr_z(i + 1, 3, &
2715 & 0) = (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_cbr_z(i + 1, 3, &
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_cbr_z(i + 1, 3, &
2724 & 2) = (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 y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1)
2728 poly_coef_cbl_z(i + 1, 3, &
2729 & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2730 & + y(2) + y(3) + y(4)))
2731 poly_coef_cbl_z(i + 1, 3, &
2732 & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) &
2733 & + 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) &
2734 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2735 poly_coef_cbl_z(i + 1, 3, &
2736 & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 &
2737 & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) &
2738 & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4)))
2739
2740 y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1)
2741 poly_coef_cbl_z(i + 1, 2, &
2742 & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) &
2743 & + y(2) + y(3) + y(4)))
2744 poly_coef_cbl_z(i + 1, 2, &
2745 & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) &
2746 & + 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) &
2747 & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2748 poly_coef_cbl_z(i + 1, 2, &
2749 & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2750 & + y(2) + y(3) + y(4)))
2751
2752 y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1)
2753 poly_coef_cbl_z(i + 1, 1, &
2754 & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) &
2755 & + y(4))*(y(1) + y(2) + y(3) + y(4)))
2756 poly_coef_cbl_z(i + 1, 1, &
2757 & 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 &
2758 & + 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) &
2759 & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2760 poly_coef_cbl_z(i + 1, 1, &
2761 & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) &
2762 & + y(2) + y(3) + y(4)))
2763
2764 y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1)
2765 poly_coef_cbl_z(i + 1, 0, &
2766 & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 &
2767 & + 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) &
2768 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)))
2769 poly_coef_cbl_z(i + 1, 0, &
2770 & 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) &
2771 & + 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)) &
2772 & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2773 & + y(4)))
2774 poly_coef_cbl_z(i + 1, 0, &
2775 & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) &
2776 & + y(3))*(y(1) + y(2) + y(3) + y(4)))
2777
2778 poly_coef_cbl_z(i + 1,:,:) = -poly_coef_cbl_z(i + 1,:,:)
2779 ! Note: negative sign as the direction of taking the difference (dvd) is reversed
2780
2781 y = s_cb(i - 2:i + 1) - s_cb(i - 3:i)
2782 beta_coef_z(i + 1, 3, &
2783 & 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) &
2784 & + 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) &
2785 & **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 &
2786 & + 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) &
2787 & *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) &
2788 & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) &
2789 & + 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) &
2790 & *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) &
2791 & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) &
2792 & **2*(y(1) + y(2) + y(3) + y(4))**2)
2793 beta_coef_z(i + 1, 3, &
2794 & 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) &
2795 & **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) &
2796 & + 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) &
2797 & + 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) &
2798 & + 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) &
2799 & *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) &
2800 & *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) &
2801 & *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) &
2802 & **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) &
2803 & **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) &
2804 & *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) &
2805 & + 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) &
2806 & *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) &
2807 & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) &
2808 & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) &
2809 & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2810 beta_coef_z(i + 1, 3, &
2811 & 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) &
2812 & **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) &
2813 & + 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) &
2814 & *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 &
2815 & + 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) &
2816 & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 &
2817 & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
2818 & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2819 beta_coef_z(i + 1, 3, &
2820 & 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 &
2821 & + 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 &
2822 & + 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 &
2823 & + 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) &
2824 & + 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) &
2825 & **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) &
2826 & **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) &
2827 & **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) &
2828 & **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) &
2829 & *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) &
2830 & **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) &
2831 & **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) &
2832 & **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) &
2833 & **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) &
2834 & **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) &
2835 & **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) &
2836 & **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) &
2837 & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) &
2838 & + 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 &
2839 & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 &
2840 & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) &
2841 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2842 & + y(3) + y(4))**2)
2843 beta_coef_z(i + 1, 3, &
2844 & 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) &
2845 & **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) &
2846 & **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) &
2847 & **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) &
2848 & *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) &
2849 & *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) &
2850 & **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) &
2851 & **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) &
2852 & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) &
2853 & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 &
2854 & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 &
2855 & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) &
2856 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2857 beta_coef_z(i + 1, 3, &
2858 & 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 &
2859 & + 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) &
2860 & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 &
2861 & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) &
2862 & + y(4))**2)
2863
2864 y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1)
2865 beta_coef_z(i + 1, 2, &
2866 & 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 &
2867 & + 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) &
2868 & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 &
2869 & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) &
2870 & + y(4))**2)
2871 beta_coef_z(i + 1, 2, &
2872 & 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 &
2873 & + 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) &
2874 & - 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 &
2875 & - 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 &
2876 & + 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 &
2877 & + 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 &
2878 & + 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 &
2879 & + 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) &
2880 & **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 &
2881 & - 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 &
2882 & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 &
2883 & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) &
2884 & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) &
2885 & **2)
2886 beta_coef_z(i + 1, 2, &
2887 & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 &
2888 & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 &
2889 & + 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) &
2890 & *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)) &
2891 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2892 & + y(4))**2)
2893 beta_coef_z(i + 1, 2, &
2894 & 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 &
2895 & + 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 &
2896 & + 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 &
2897 & + 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) &
2898 & + 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) &
2899 & **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) &
2900 & **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) &
2901 & **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) &
2902 & **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) &
2903 & *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 &
2904 & + 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) &
2905 & **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 &
2906 & + 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 &
2907 & + 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) &
2908 & **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) &
2909 & *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) &
2910 & + 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 &
2911 & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 &
2912 & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) &
2913 & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) &
2914 & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2915 & + y(3) + y(4))**2)
2916 beta_coef_z(i + 1, 2, &
2917 & 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) &
2918 & **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) &
2919 & *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) &
2920 & *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) &
2921 & *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) &
2922 & **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) &
2923 & **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) &
2924 & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) &
2925 & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) &
2926 & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) &
2927 & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) &
2928 & **2)
2929 beta_coef_z(i + 1, 2, &
2930 & 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 &
2931 & - 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)) &
2932 & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2)
2933
2934 y = s_cb(i:i + 3) - s_cb(i - 1:i + 2)
2935 beta_coef_z(i + 1, 1, &
2936 & 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 &
2937 & - 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)) &
2938 & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2939 beta_coef_z(i + 1, 1, &
2940 & 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) &
2941 & *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) &
2942 & **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) &
2943 & **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) &
2944 & **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) &
2945 & **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) &
2946 & **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) &
2947 & *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) &
2948 & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) &
2949 & **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) &
2950 & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
2951 & + y(3) + y(4))**2)
2952 beta_coef_z(i + 1, 1, &
2953 & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 &
2954 & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 &
2955 & + 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) &
2956 & *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)) &
2957 & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
2958 & + y(4))**2)
2959 beta_coef_z(i + 1, 1, &
2960 & 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) &
2961 & + 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) &
2962 & **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) &
2963 & **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) &
2964 & **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) &
2965 & **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) &
2966 & + 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) &
2967 & **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) &
2968 & **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) &
2969 & **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) &
2970 & **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) &
2971 & - 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) &
2972 & **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) &
2973 & **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) &
2974 & *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) &
2975 & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) &
2976 & **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) &
2977 & **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) &
2978 & **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) &
2979 & **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) &
2980 & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
2981 beta_coef_z(i + 1, 1, &
2982 & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) &
2983 & **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) &
2984 & **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) &
2985 & *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) &
2986 & + 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) &
2987 & **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) &
2988 & **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) &
2989 & **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) &
2990 & **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 &
2991 & - 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 &
2992 & - 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) &
2993 & **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) &
2994 & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
2995 beta_coef_z(i + 1, 1, &
2996 & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) &
2997 & **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 &
2998 & + 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) &
2999 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3000 & + y(3) + y(4))**2)
3001
3002 y = s_cb(i + 1:i + 4) - s_cb(i:i + 3)
3003 beta_coef_z(i + 1, 0, &
3004 & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) &
3005 & **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 &
3006 & + 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) &
3007 & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) &
3008 & + y(3) + y(4))**2)
3009 beta_coef_z(i + 1, 0, &
3010 & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) &
3011 & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) &
3012 & **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) &
3013 & **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) &
3014 & + 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) &
3015 & **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 &
3016 & + 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) &
3017 & **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) &
3018 & *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 &
3019 & + 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) &
3020 & + 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) &
3021 & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) &
3022 & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3023 beta_coef_z(i + 1, 0, &
3024 & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) &
3025 & *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) &
3026 & + 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) &
3027 & **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) &
3028 & + 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) &
3029 & *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) &
3030 & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) &
3031 & + y(4))*(y(1) + y(2) + y(3) + y(4))**2)
3032 beta_coef_z(i + 1, 0, &
3033 & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) &
3034 & **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) &
3035 & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 &
3036 & + 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) &
3037 & + 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) &
3038 & *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) &
3039 & *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) &
3040 & + 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) &
3041 & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 &
3042 & + 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) &
3043 & **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) &
3044 & **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) &
3045 & *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) &
3046 & **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) &
3047 & **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 &
3048 & + 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) &
3049 & + 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 &
3050 & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 &
3051 & + 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) &
3052 & **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) &
3053 & **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) &
3054 & **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)) &
3055 & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2)
3056 beta_coef_z(i + 1, 0, &
3057 & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) &
3058 & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) &
3059 & **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) &
3060 & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) &
3061 & **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) &
3062 & **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) &
3063 & **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) &
3064 & + 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) &
3065 & + 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) &
3066 & + 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) &
3067 & *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 &
3068 & + 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) &
3069 & *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) &
3070 & + 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) &
3071 & **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)) &
3072 & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) &
3073 & + y(4))**2)
3074 beta_coef_z(i + 1, 0, &
3075 & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) &
3076 & **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) &
3077 & + 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) &
3078 & *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 &
3079 & + 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) &
3080 & **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) &
3081 & + 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) &
3082 & **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) &
3083 & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) &
3084 & + y(3) + y(4))**2)
3085 end do
3086 else ! TENO (only supports uniform grid)
3087 ! (Fu, et al., 2016) Table 2 (for right flux)
3088 d_cbl_z(0,:) = 18._wp/35._wp
3089 d_cbl_z(1,:) = 3._wp/35._wp
3090 d_cbl_z(2,:) = 9._wp/35._wp
3091 d_cbl_z(3,:) = 1._wp/35._wp
3092 d_cbl_z(4,:) = 4._wp/35._wp
3093
3094 d_cbr_z(0,:) = 18._wp/35._wp
3095 d_cbr_z(1,:) = 9._wp/35._wp
3096 d_cbr_z(2,:) = 3._wp/35._wp
3097 d_cbr_z(3,:) = 4._wp/35._wp
3098 d_cbr_z(4,:) = 1._wp/35._wp
3099 end if
3100 end if
3101 end if
3102# 844 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3103
3104 if (weno_dir == 1) then
3105
3106# 846 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3107#if defined(MFC_OpenACC)
3108# 846 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3109!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
3110# 846 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3111#elif defined(MFC_OpenMP)
3112# 846 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3113!$omp target update to(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
3114# 846 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3115#endif
3116 else if (weno_dir == 2) then
3117
3118# 848 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3119#if defined(MFC_OpenACC)
3120# 848 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3121!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
3122# 848 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3123#elif defined(MFC_OpenMP)
3124# 848 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3125!$omp target update to(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
3126# 848 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3127#endif
3128 else
3129
3130# 850 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3131#if defined(MFC_OpenACC)
3132# 850 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3133!$acc update device(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z)
3134# 850 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3135#elif defined(MFC_OpenMP)
3136# 850 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3137!$omp target update to(poly_coef_cbL_z, poly_coef_cbR_z, d_cbL_z, d_cbR_z, beta_coef_z)
3138# 850 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3139#endif
3140 end if
3141
3142 ! Nullifying WENO coefficients and cell-boundary locations pointers
3143
3144 nullify (s_cb)
3145
3146 end subroutine s_compute_weno_coefficients
3147
3148 !> Perform WENO reconstruction of left and right cell-boundary values from cell-averaged variables
3149 subroutine s_weno(v_vf, vL_rs_vf_x, vL_rs_vf_y, vL_rs_vf_z, vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z, weno_dir, is1_weno_d, &
3150
3151 & is2_weno_d, is3_weno_d)
3152
3153 type(scalar_field), dimension(1:), intent(in) :: v_vf
3154 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z
3155 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z
3156 integer, intent(in) :: weno_dir
3157 type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d
3158
3159# 878 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3160 real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd
3161 real(wp), dimension(0:weno_num_stencils) :: poly
3162 real(wp), dimension(0:weno_num_stencils) :: alpha
3163 real(wp), dimension(0:weno_num_stencils) :: omega
3164 real(wp), dimension(0:weno_num_stencils) :: beta
3165 real(wp), dimension(0:weno_num_stencils) :: delta
3166# 885 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3167 real(wp), dimension(-3:3) :: v !< temporary field value array for clarity (WENO7 only)
3168 real(wp) :: tau
3169 integer :: i, j, k, l, q
3170
3171 is1_weno = is1_weno_d
3172 is2_weno = is2_weno_d
3173 is3_weno = is3_weno_d
3174
3175
3176# 893 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3177#if defined(MFC_OpenACC)
3178# 893 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3179!$acc update device(is1_weno, is2_weno, is3_weno)
3180# 893 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3181#elif defined(MFC_OpenMP)
3182# 893 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3183!$omp target update to(is1_weno, is2_weno, is3_weno)
3184# 893 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3185#endif
3186
3187 if (weno_order /= 1 .or. dummy) then
3188 call s_initialize_weno(v_vf, weno_dir)
3189 end if
3190
3191 if (weno_order == 1 .or. dummy) then
3192 if (weno_dir == 1) then
3193
3194# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3195
3196# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3197#if defined(MFC_OpenACC)
3198# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3199!$acc parallel loop collapse(4) gang vector default(present)
3200# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3201#elif defined(MFC_OpenMP)
3202# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3203
3204# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3205
3206# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3207
3208# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3209!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3210# 901 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3211#endif
3212 do i = 1, ubound(v_vf, 1)
3213 do l = is3_weno%beg, is3_weno%end
3214 do k = is2_weno%beg, is2_weno%end
3215 do j = is1_weno%beg, is1_weno%end
3216 vl_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3217 vr_rs_vf_x(j, k, l, i) = v_vf(i)%sf(j, k, l)
3218 end do
3219 end do
3220 end do
3221 end do
3222
3223# 912 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3224#if defined(MFC_OpenACC)
3225# 912 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3226!$acc end parallel loop
3227# 912 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3228#elif defined(MFC_OpenMP)
3229# 912 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3230
3231# 912 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3232!$omp end target teams loop
3233# 912 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3234#endif
3235 else if (weno_dir == 2) then
3236
3237# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3238
3239# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3240#if defined(MFC_OpenACC)
3241# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3242!$acc parallel loop collapse(4) gang vector default(present)
3243# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3244#elif defined(MFC_OpenMP)
3245# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3246
3247# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3248
3249# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3250
3251# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3252!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3253# 914 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3254#endif
3255 do i = 1, ubound(v_vf, 1)
3256 do l = is3_weno%beg, is3_weno%end
3257 do k = is2_weno%beg, is2_weno%end
3258 do j = is1_weno%beg, is1_weno%end
3259 vl_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
3260 vr_rs_vf_y(j, k, l, i) = v_vf(i)%sf(k, j, l)
3261 end do
3262 end do
3263 end do
3264 end do
3265
3266# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3267#if defined(MFC_OpenACC)
3268# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3269!$acc end parallel loop
3270# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3271#elif defined(MFC_OpenMP)
3272# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3273
3274# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3275!$omp end target teams loop
3276# 925 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3277#endif
3278 else if (weno_dir == 3) then
3279
3280# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3281
3282# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3283#if defined(MFC_OpenACC)
3284# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3285!$acc parallel loop collapse(4) gang vector default(present)
3286# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3287#elif defined(MFC_OpenMP)
3288# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3289
3290# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3291
3292# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3293
3294# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3295!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
3296# 927 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3297#endif
3298 do i = 1, ubound(v_vf, 1)
3299 do l = is3_weno%beg, is3_weno%end
3300 do k = is2_weno%beg, is2_weno%end
3301 do j = is1_weno%beg, is1_weno%end
3302 vl_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
3303 vr_rs_vf_z(j, k, l, i) = v_vf(i)%sf(l, k, j)
3304 end do
3305 end do
3306 end do
3307 end do
3308
3309# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3310#if defined(MFC_OpenACC)
3311# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3312!$acc end parallel loop
3313# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3314#elif defined(MFC_OpenMP)
3315# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3316
3317# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3318!$omp end target teams loop
3319# 938 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3320#endif
3321 end if
3322 end if
3323 if (weno_order == 3 .or. dummy) then
3324# 943 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3325 if (weno_dir == 1) then
3326
3327# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3328
3329# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3330#if defined(MFC_OpenACC)
3331# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3332!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
3333# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3334#elif defined(MFC_OpenMP)
3335# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3336
3337# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3338
3339# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3340
3341# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3342!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(beta, dvd, poly, omega, alpha, tau)
3343# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3344#endif
3345 do l = is3_weno%beg, is3_weno%end
3346 do k = is2_weno%beg, is2_weno%end
3347 do j = is1_weno%beg, is1_weno%end
3348 do i = 1, v_size
3349 ! reconstruct from left side
3350
3351 alpha(:) = 0._wp
3352 omega(:) = 0._wp
3353 beta(:) = weno_eps
3354
3355 dvd(0) = v_rs_ws_x(j + 1, k, l, i) - v_rs_ws_x(j, k, l, i)
3356 dvd(-1) = v_rs_ws_x(j, k, l, i) - v_rs_ws_x(j - 1, k, l, i)
3357
3358 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 0, 0)*dvd(0)
3359 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 1, 0)*dvd(-1)
3360
3361 beta(0) = beta_coef_x(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3362 beta(1) = beta_coef_x(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3363
3364 if (wenojs) then
3365 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
3366 & j)/(beta(0:weno_num_stencils)**2._wp)
3367 else if (mapped_weno) then
3368 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
3369 & j)/(beta(0:weno_num_stencils)**2._wp)
3370 omega = alpha/sum(alpha)
3371 alpha(0:weno_num_stencils) = (d_cbl_x(0:weno_num_stencils, &
3372 & j)*(1._wp + d_cbl_x(0:weno_num_stencils, &
3373 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3374 & *(omega(0:weno_num_stencils)/(d_cbl_x(0:weno_num_stencils, &
3375 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3376 & - 2._wp*d_cbl_x(0:weno_num_stencils,j))))
3377 else if (wenoz) then
3378 ! Borges, et al. (2008)
3379
3380 tau = abs(beta(1) - beta(0))
3381 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
3382 & j)*(1._wp + tau/beta(0:weno_num_stencils))
3383 end if
3384
3385 omega = alpha/sum(alpha)
3386
3387 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3388
3389 ! reconstruct from right side
3390
3391 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3392 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3393
3394 if (wenojs) then
3395 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
3396 & j)/(beta(0:weno_num_stencils)**2._wp)
3397 else if (mapped_weno) then
3398 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
3399 & j)/(beta(0:weno_num_stencils)**2._wp)
3400 omega = alpha/sum(alpha)
3401 alpha(0:weno_num_stencils) = (d_cbr_x(0:weno_num_stencils, &
3402 & j)*(1._wp + d_cbr_x(0:weno_num_stencils, &
3403 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3404 & *(omega(0:weno_num_stencils)/(d_cbr_x(0:weno_num_stencils, &
3405 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3406 & - 2._wp*d_cbr_x(0:weno_num_stencils,j))))
3407 else if (wenoz) then
3408 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
3409 & j)*(1._wp + tau/beta(0:weno_num_stencils))
3410 end if
3411
3412 omega = alpha/sum(alpha)
3413
3414 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3415 end do
3416 end do
3417 end do
3418 end do
3419
3420# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3421#if defined(MFC_OpenACC)
3422# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3423!$acc end parallel loop
3424# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3425#elif defined(MFC_OpenMP)
3426# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3427
3428# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3429!$omp end target teams loop
3430# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3431#endif
3432 end if
3433# 943 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3434 if (weno_dir == 2) then
3435
3436# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3437
3438# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3439#if defined(MFC_OpenACC)
3440# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3441!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
3442# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3443#elif defined(MFC_OpenMP)
3444# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3445
3446# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3447
3448# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3449
3450# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3451!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(beta, dvd, poly, omega, alpha, tau)
3452# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3453#endif
3454 do l = is3_weno%beg, is3_weno%end
3455 do k = is2_weno%beg, is2_weno%end
3456 do j = is1_weno%beg, is1_weno%end
3457 do i = 1, v_size
3458 ! reconstruct from left side
3459
3460 alpha(:) = 0._wp
3461 omega(:) = 0._wp
3462 beta(:) = weno_eps
3463
3464 dvd(0) = v_rs_ws_y(j + 1, k, l, i) - v_rs_ws_y(j, k, l, i)
3465 dvd(-1) = v_rs_ws_y(j, k, l, i) - v_rs_ws_y(j - 1, k, l, i)
3466
3467 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 0, 0)*dvd(0)
3468 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 1, 0)*dvd(-1)
3469
3470 beta(0) = beta_coef_y(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3471 beta(1) = beta_coef_y(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3472
3473 if (wenojs) then
3474 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
3475 & j)/(beta(0:weno_num_stencils)**2._wp)
3476 else if (mapped_weno) then
3477 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
3478 & j)/(beta(0:weno_num_stencils)**2._wp)
3479 omega = alpha/sum(alpha)
3480 alpha(0:weno_num_stencils) = (d_cbl_y(0:weno_num_stencils, &
3481 & j)*(1._wp + d_cbl_y(0:weno_num_stencils, &
3482 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3483 & *(omega(0:weno_num_stencils)/(d_cbl_y(0:weno_num_stencils, &
3484 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3485 & - 2._wp*d_cbl_y(0:weno_num_stencils,j))))
3486 else if (wenoz) then
3487 ! Borges, et al. (2008)
3488
3489 tau = abs(beta(1) - beta(0))
3490 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
3491 & j)*(1._wp + tau/beta(0:weno_num_stencils))
3492 end if
3493
3494 omega = alpha/sum(alpha)
3495
3496 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3497
3498 ! reconstruct from right side
3499
3500 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 0, 0)*dvd(0)
3501 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 1, 0)*dvd(-1)
3502
3503 if (wenojs) then
3504 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
3505 & j)/(beta(0:weno_num_stencils)**2._wp)
3506 else if (mapped_weno) then
3507 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
3508 & j)/(beta(0:weno_num_stencils)**2._wp)
3509 omega = alpha/sum(alpha)
3510 alpha(0:weno_num_stencils) = (d_cbr_y(0:weno_num_stencils, &
3511 & j)*(1._wp + d_cbr_y(0:weno_num_stencils, &
3512 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3513 & *(omega(0:weno_num_stencils)/(d_cbr_y(0:weno_num_stencils, &
3514 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3515 & - 2._wp*d_cbr_y(0:weno_num_stencils,j))))
3516 else if (wenoz) then
3517 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
3518 & j)*(1._wp + tau/beta(0:weno_num_stencils))
3519 end if
3520
3521 omega = alpha/sum(alpha)
3522
3523 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3524 end do
3525 end do
3526 end do
3527 end do
3528
3529# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3530#if defined(MFC_OpenACC)
3531# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3532!$acc end parallel loop
3533# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3534#elif defined(MFC_OpenMP)
3535# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3536
3537# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3538!$omp end target teams loop
3539# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3540#endif
3541 end if
3542# 943 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3543 if (weno_dir == 3) then
3544
3545# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3546
3547# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3548#if defined(MFC_OpenACC)
3549# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3550!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau)
3551# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3552#elif defined(MFC_OpenMP)
3553# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3554
3555# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3556
3557# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3558
3559# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3560!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(beta, dvd, poly, omega, alpha, tau)
3561# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3562#endif
3563 do l = is3_weno%beg, is3_weno%end
3564 do k = is2_weno%beg, is2_weno%end
3565 do j = is1_weno%beg, is1_weno%end
3566 do i = 1, v_size
3567 ! reconstruct from left side
3568
3569 alpha(:) = 0._wp
3570 omega(:) = 0._wp
3571 beta(:) = weno_eps
3572
3573 dvd(0) = v_rs_ws_z(j + 1, k, l, i) - v_rs_ws_z(j, k, l, i)
3574 dvd(-1) = v_rs_ws_z(j, k, l, i) - v_rs_ws_z(j - 1, k, l, i)
3575
3576 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 0, 0)*dvd(0)
3577 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 1, 0)*dvd(-1)
3578
3579 beta(0) = beta_coef_z(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3580 beta(1) = beta_coef_z(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3581
3582 if (wenojs) then
3583 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
3584 & j)/(beta(0:weno_num_stencils)**2._wp)
3585 else if (mapped_weno) then
3586 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
3587 & j)/(beta(0:weno_num_stencils)**2._wp)
3588 omega = alpha/sum(alpha)
3589 alpha(0:weno_num_stencils) = (d_cbl_z(0:weno_num_stencils, &
3590 & j)*(1._wp + d_cbl_z(0:weno_num_stencils, &
3591 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3592 & *(omega(0:weno_num_stencils)/(d_cbl_z(0:weno_num_stencils, &
3593 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3594 & - 2._wp*d_cbl_z(0:weno_num_stencils,j))))
3595 else if (wenoz) then
3596 ! Borges, et al. (2008)
3597
3598 tau = abs(beta(1) - beta(0))
3599 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
3600 & j)*(1._wp + tau/beta(0:weno_num_stencils))
3601 end if
3602
3603 omega = alpha/sum(alpha)
3604
3605 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3606
3607 ! reconstruct from right side
3608
3609 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 0, 0)*dvd(0)
3610 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 1, 0)*dvd(-1)
3611
3612 if (wenojs) then
3613 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
3614 & j)/(beta(0:weno_num_stencils)**2._wp)
3615 else if (mapped_weno) then
3616 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
3617 & j)/(beta(0:weno_num_stencils)**2._wp)
3618 omega = alpha/sum(alpha)
3619 alpha(0:weno_num_stencils) = (d_cbr_z(0:weno_num_stencils, &
3620 & j)*(1._wp + d_cbr_z(0:weno_num_stencils, &
3621 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3622 & *(omega(0:weno_num_stencils)/(d_cbr_z(0:weno_num_stencils, &
3623 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3624 & - 2._wp*d_cbr_z(0:weno_num_stencils,j))))
3625 else if (wenoz) then
3626 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
3627 & j)*(1._wp + tau/beta(0:weno_num_stencils))
3628 end if
3629
3630 omega = alpha/sum(alpha)
3631
3632 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3633 end do
3634 end do
3635 end do
3636 end do
3637
3638# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3639#if defined(MFC_OpenACC)
3640# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3641!$acc end parallel loop
3642# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3643#elif defined(MFC_OpenMP)
3644# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3645
3646# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3647!$omp end target teams loop
3648# 1019 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3649#endif
3650 end if
3651# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3652 end if
3653 if (weno_order == 5 .or. dummy) then
3654# 1025 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3655# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3656 if (weno_dir == 1) then
3657
3658# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3659
3660# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3661#if defined(MFC_OpenACC)
3662# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3663!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3664# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3665#elif defined(MFC_OpenMP)
3666# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3667
3668# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3669
3670# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3671
3672# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3673!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3674# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3675#endif
3676 do l = is3_weno%beg, is3_weno%end
3677 do k = is2_weno%beg, is2_weno%end
3678 do j = is1_weno%beg, is1_weno%end
3679
3680# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3681#if defined(MFC_OpenACC)
3682# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3683!$acc loop seq
3684# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3685#elif defined(MFC_OpenMP)
3686# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3687
3688# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3689#endif
3690 do i = 1, v_size
3691 ! reconstruct from left side
3692
3693 alpha(:) = 0._wp
3694 omega(:) = 0._wp
3695 delta(:) = 0._wp
3696 beta(:) = weno_eps
3697
3698 dvd(1) = v_rs_ws_x(j + 2, k, l, i) - v_rs_ws_x(j + 1, k, l, i)
3699 dvd(0) = v_rs_ws_x(j + 1, k, l, i) - v_rs_ws_x(j, k, l, i)
3700 dvd(-1) = v_rs_ws_x(j, k, l, i) - v_rs_ws_x(j - 1, k, l, i)
3701 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) - v_rs_ws_x(j - 2, k, l, i)
3702
3703 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 0, &
3704 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3705 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 1, &
3706 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3707 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 2, &
3708 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3709
3710 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
3711 & 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3712 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
3713 & 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 2)*dvd(-1)*dvd(-1) + weno_eps
3714 beta(2) = beta_coef_x(j, 2, 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3715 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3716
3717 if (wenojs) then
3718 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
3719 & j)/(beta(0:weno_num_stencils)**2._wp)
3720 else if (mapped_weno) then
3721 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
3722 & j)/(beta(0:weno_num_stencils)**2._wp)
3723 omega = alpha/sum(alpha)
3724 alpha(0:weno_num_stencils) = (d_cbl_x(0:weno_num_stencils, &
3725 & j)*(1._wp + d_cbl_x(0:weno_num_stencils, &
3726 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3727 & *(omega(0:weno_num_stencils)/(d_cbl_x(0:weno_num_stencils, &
3728 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3729 & - 2._wp*d_cbl_x(0:weno_num_stencils,j))))
3730 else if (wenoz) then
3731 ! Borges, et al. (2008)
3732
3733 tau = abs(beta(2) - beta(0)) ! Equation 25
3734
3735# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3736#if defined(MFC_OpenACC)
3737# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3738!$acc loop seq
3739# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3740#elif defined(MFC_OpenMP)
3741# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3742
3743# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3744#endif
3745 do q = 0, weno_num_stencils
3746 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3747 ! Equation 28 (note: weno_eps was already added to beta)
3748 end do
3749 else if (teno) then
3750 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3751 tau = abs(beta(2) - beta(0))
3752
3753# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3754#if defined(MFC_OpenACC)
3755# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3756!$acc loop seq
3757# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3758#elif defined(MFC_OpenMP)
3759# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3760
3761# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3762#endif
3763 do q = 0, weno_num_stencils
3764 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3765 alpha(q) = (alpha(q)**3._wp) &
3766 & **2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3767 end do
3768 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3769
3770
3771# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3772#if defined(MFC_OpenACC)
3773# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3774!$acc loop seq
3775# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3776#elif defined(MFC_OpenMP)
3777# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3778
3779# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3780#endif
3781 do q = 0, weno_num_stencils
3782 if (omega(q) < teno_ct) then ! Equation 26
3783 delta(q) = 0._wp
3784 else
3785 delta(q) = 1._wp
3786 end if
3787 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3788 end do
3789 end if
3790
3791 omega = alpha/sum(alpha)
3792
3793 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3794
3795 ! reconstruct from right side
3796
3797 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 0, &
3798 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3799 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 1, &
3800 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3801 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 2, &
3802 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3803
3804 if (wenojs) then
3805 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
3806 & j)/(beta(0:weno_num_stencils)**2._wp)
3807 else if (mapped_weno) then
3808 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
3809 & j)/(beta(0:weno_num_stencils)**2._wp)
3810 omega = alpha/sum(alpha)
3811 alpha(0:weno_num_stencils) = (d_cbr_x(0:weno_num_stencils, &
3812 & j)*(1._wp + d_cbr_x(0:weno_num_stencils, &
3813 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3814 & *(omega(0:weno_num_stencils)/(d_cbr_x(0:weno_num_stencils, &
3815 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3816 & - 2._wp*d_cbr_x(0:weno_num_stencils,j))))
3817 else if (wenoz) then
3818
3819# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3820#if defined(MFC_OpenACC)
3821# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3822!$acc loop seq
3823# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3824#elif defined(MFC_OpenMP)
3825# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3826
3827# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3828#endif
3829 do q = 0, weno_num_stencils
3830 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3831 end do
3832 else if (teno) then
3833
3834# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3835#if defined(MFC_OpenACC)
3836# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3837!$acc loop seq
3838# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3839#elif defined(MFC_OpenMP)
3840# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3841
3842# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3843#endif
3844 do q = 0, weno_num_stencils
3845 alpha(q) = delta(q)*d_cbr_x(q, j)
3846 end do
3847 end if
3848
3849 omega = alpha/sum(alpha)
3850
3851 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3852 end do
3853 end do
3854 end do
3855 end do
3856
3857# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3858#if defined(MFC_OpenACC)
3859# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3860!$acc end parallel loop
3861# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3862#elif defined(MFC_OpenMP)
3863# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3864
3865# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3866!$omp end target teams loop
3867# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3868#endif
3869
3870 if (mp_weno) then
3871 call s_preserve_monotonicity(v_rs_ws_x, vl_rs_vf_x, vr_rs_vf_x)
3872 end if
3873 end if
3874# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3875 if (weno_dir == 2) then
3876
3877# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3878
3879# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3880#if defined(MFC_OpenACC)
3881# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3882!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3883# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3884#elif defined(MFC_OpenMP)
3885# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3886
3887# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3888
3889# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3890
3891# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3892!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3893# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3894#endif
3895 do l = is3_weno%beg, is3_weno%end
3896 do k = is2_weno%beg, is2_weno%end
3897 do j = is1_weno%beg, is1_weno%end
3898
3899# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3900#if defined(MFC_OpenACC)
3901# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3902!$acc loop seq
3903# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3904#elif defined(MFC_OpenMP)
3905# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3906
3907# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3908#endif
3909 do i = 1, v_size
3910 ! reconstruct from left side
3911
3912 alpha(:) = 0._wp
3913 omega(:) = 0._wp
3914 delta(:) = 0._wp
3915 beta(:) = weno_eps
3916
3917 dvd(1) = v_rs_ws_y(j + 2, k, l, i) - v_rs_ws_y(j + 1, k, l, i)
3918 dvd(0) = v_rs_ws_y(j + 1, k, l, i) - v_rs_ws_y(j, k, l, i)
3919 dvd(-1) = v_rs_ws_y(j, k, l, i) - v_rs_ws_y(j - 1, k, l, i)
3920 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) - v_rs_ws_y(j - 2, k, l, i)
3921
3922 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 0, &
3923 & 0)*dvd(1) + poly_coef_cbl_y(j, 0, 1)*dvd(0)
3924 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 1, &
3925 & 0)*dvd(0) + poly_coef_cbl_y(j, 1, 1)*dvd(-1)
3926 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 2, &
3927 & 0)*dvd(-1) + poly_coef_cbl_y(j, 2, 1)*dvd(-2)
3928
3929 beta(0) = beta_coef_y(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(j, 0, &
3930 & 1)*dvd(1)*dvd(0) + beta_coef_y(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3931 beta(1) = beta_coef_y(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(j, 1, &
3932 & 1)*dvd(0)*dvd(-1) + beta_coef_y(j, 1, 2)*dvd(-1)*dvd(-1) + weno_eps
3933 beta(2) = beta_coef_y(j, 2, 0)*dvd(-1)*dvd(-1) + beta_coef_y(j, 2, &
3934 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3935
3936 if (wenojs) then
3937 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
3938 & j)/(beta(0:weno_num_stencils)**2._wp)
3939 else if (mapped_weno) then
3940 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
3941 & j)/(beta(0:weno_num_stencils)**2._wp)
3942 omega = alpha/sum(alpha)
3943 alpha(0:weno_num_stencils) = (d_cbl_y(0:weno_num_stencils, &
3944 & j)*(1._wp + d_cbl_y(0:weno_num_stencils, &
3945 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
3946 & *(omega(0:weno_num_stencils)/(d_cbl_y(0:weno_num_stencils, &
3947 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
3948 & - 2._wp*d_cbl_y(0:weno_num_stencils,j))))
3949 else if (wenoz) then
3950 ! Borges, et al. (2008)
3951
3952 tau = abs(beta(2) - beta(0)) ! Equation 25
3953
3954# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3955#if defined(MFC_OpenACC)
3956# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3957!$acc loop seq
3958# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3959#elif defined(MFC_OpenMP)
3960# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3961
3962# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3963#endif
3964 do q = 0, weno_num_stencils
3965 alpha(q) = d_cbl_y(q, j)*(1._wp + (tau/beta(q)))
3966 ! Equation 28 (note: weno_eps was already added to beta)
3967 end do
3968 else if (teno) then
3969 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3970 tau = abs(beta(2) - beta(0))
3971
3972# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3973#if defined(MFC_OpenACC)
3974# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3975!$acc loop seq
3976# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3977#elif defined(MFC_OpenMP)
3978# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3979
3980# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3981#endif
3982 do q = 0, weno_num_stencils
3983 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3984 alpha(q) = (alpha(q)**3._wp) &
3985 & **2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3986 end do
3987 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3988
3989
3990# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3991#if defined(MFC_OpenACC)
3992# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3993!$acc loop seq
3994# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3995#elif defined(MFC_OpenMP)
3996# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3997
3998# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3999#endif
4000 do q = 0, weno_num_stencils
4001 if (omega(q) < teno_ct) then ! Equation 26
4002 delta(q) = 0._wp
4003 else
4004 delta(q) = 1._wp
4005 end if
4006 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
4007 end do
4008 end if
4009
4010 omega = alpha/sum(alpha)
4011
4012 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4013
4014 ! reconstruct from right side
4015
4016 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 0, &
4017 & 0)*dvd(1) + poly_coef_cbr_y(j, 0, 1)*dvd(0)
4018 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 1, &
4019 & 0)*dvd(0) + poly_coef_cbr_y(j, 1, 1)*dvd(-1)
4020 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 2, &
4021 & 0)*dvd(-1) + poly_coef_cbr_y(j, 2, 1)*dvd(-2)
4022
4023 if (wenojs) then
4024 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
4025 & j)/(beta(0:weno_num_stencils)**2._wp)
4026 else if (mapped_weno) then
4027 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
4028 & j)/(beta(0:weno_num_stencils)**2._wp)
4029 omega = alpha/sum(alpha)
4030 alpha(0:weno_num_stencils) = (d_cbr_y(0:weno_num_stencils, &
4031 & j)*(1._wp + d_cbr_y(0:weno_num_stencils, &
4032 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4033 & *(omega(0:weno_num_stencils)/(d_cbr_y(0:weno_num_stencils, &
4034 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4035 & - 2._wp*d_cbr_y(0:weno_num_stencils,j))))
4036 else if (wenoz) then
4037
4038# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4039#if defined(MFC_OpenACC)
4040# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4041!$acc loop seq
4042# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4043#elif defined(MFC_OpenMP)
4044# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4045
4046# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4047#endif
4048 do q = 0, weno_num_stencils
4049 alpha(q) = d_cbr_y(q, j)*(1._wp + (tau/beta(q)))
4050 end do
4051 else if (teno) then
4052
4053# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4054#if defined(MFC_OpenACC)
4055# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4056!$acc loop seq
4057# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4058#elif defined(MFC_OpenMP)
4059# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4060
4061# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4062#endif
4063 do q = 0, weno_num_stencils
4064 alpha(q) = delta(q)*d_cbr_y(q, j)
4065 end do
4066 end if
4067
4068 omega = alpha/sum(alpha)
4069
4070 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4071 end do
4072 end do
4073 end do
4074 end do
4075
4076# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4077#if defined(MFC_OpenACC)
4078# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4079!$acc end parallel loop
4080# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4081#elif defined(MFC_OpenMP)
4082# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4083
4084# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4085!$omp end target teams loop
4086# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4087#endif
4088
4089 if (mp_weno) then
4090 call s_preserve_monotonicity(v_rs_ws_y, vl_rs_vf_y, vr_rs_vf_y)
4091 end if
4092 end if
4093# 1026 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4094 if (weno_dir == 3) then
4095
4096# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4097
4098# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4099#if defined(MFC_OpenACC)
4100# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4101!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
4102# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4103#elif defined(MFC_OpenMP)
4104# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4105
4106# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4107
4108# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4109
4110# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4111!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(dvd, poly, beta, alpha, omega, tau, delta, q)
4112# 1027 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4113#endif
4114 do l = is3_weno%beg, is3_weno%end
4115 do k = is2_weno%beg, is2_weno%end
4116 do j = is1_weno%beg, is1_weno%end
4117
4118# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4119#if defined(MFC_OpenACC)
4120# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4121!$acc loop seq
4122# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4123#elif defined(MFC_OpenMP)
4124# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4125
4126# 1031 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4127#endif
4128 do i = 1, v_size
4129 ! reconstruct from left side
4130
4131 alpha(:) = 0._wp
4132 omega(:) = 0._wp
4133 delta(:) = 0._wp
4134 beta(:) = weno_eps
4135
4136 dvd(1) = v_rs_ws_z(j + 2, k, l, i) - v_rs_ws_z(j + 1, k, l, i)
4137 dvd(0) = v_rs_ws_z(j + 1, k, l, i) - v_rs_ws_z(j, k, l, i)
4138 dvd(-1) = v_rs_ws_z(j, k, l, i) - v_rs_ws_z(j - 1, k, l, i)
4139 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) - v_rs_ws_z(j - 2, k, l, i)
4140
4141 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 0, &
4142 & 0)*dvd(1) + poly_coef_cbl_z(j, 0, 1)*dvd(0)
4143 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 1, &
4144 & 0)*dvd(0) + poly_coef_cbl_z(j, 1, 1)*dvd(-1)
4145 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 2, &
4146 & 0)*dvd(-1) + poly_coef_cbl_z(j, 2, 1)*dvd(-2)
4147
4148 beta(0) = beta_coef_z(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(j, 0, &
4149 & 1)*dvd(1)*dvd(0) + beta_coef_z(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
4150 beta(1) = beta_coef_z(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(j, 1, &
4151 & 1)*dvd(0)*dvd(-1) + beta_coef_z(j, 1, 2)*dvd(-1)*dvd(-1) + weno_eps
4152 beta(2) = beta_coef_z(j, 2, 0)*dvd(-1)*dvd(-1) + beta_coef_z(j, 2, &
4153 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4154
4155 if (wenojs) then
4156 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
4157 & j)/(beta(0:weno_num_stencils)**2._wp)
4158 else if (mapped_weno) then
4159 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
4160 & j)/(beta(0:weno_num_stencils)**2._wp)
4161 omega = alpha/sum(alpha)
4162 alpha(0:weno_num_stencils) = (d_cbl_z(0:weno_num_stencils, &
4163 & j)*(1._wp + d_cbl_z(0:weno_num_stencils, &
4164 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4165 & *(omega(0:weno_num_stencils)/(d_cbl_z(0:weno_num_stencils, &
4166 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4167 & - 2._wp*d_cbl_z(0:weno_num_stencils,j))))
4168 else if (wenoz) then
4169 ! Borges, et al. (2008)
4170
4171 tau = abs(beta(2) - beta(0)) ! Equation 25
4172
4173# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4174#if defined(MFC_OpenACC)
4175# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4176!$acc loop seq
4177# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4178#elif defined(MFC_OpenMP)
4179# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4180
4181# 1076 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4182#endif
4183 do q = 0, weno_num_stencils
4184 alpha(q) = d_cbl_z(q, j)*(1._wp + (tau/beta(q)))
4185 ! Equation 28 (note: weno_eps was already added to beta)
4186 end do
4187 else if (teno) then
4188 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4189 tau = abs(beta(2) - beta(0))
4190
4191# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4192#if defined(MFC_OpenACC)
4193# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4194!$acc loop seq
4195# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4196#elif defined(MFC_OpenMP)
4197# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4198
4199# 1084 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4200#endif
4201 do q = 0, weno_num_stencils
4202 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4203 alpha(q) = (alpha(q)**3._wp) &
4204 & **2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4205 end do
4206 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4207
4208
4209# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4210#if defined(MFC_OpenACC)
4211# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4212!$acc loop seq
4213# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4214#elif defined(MFC_OpenMP)
4215# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4216
4217# 1092 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4218#endif
4219 do q = 0, weno_num_stencils
4220 if (omega(q) < teno_ct) then ! Equation 26
4221 delta(q) = 0._wp
4222 else
4223 delta(q) = 1._wp
4224 end if
4225 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
4226 end do
4227 end if
4228
4229 omega = alpha/sum(alpha)
4230
4231 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4232
4233 ! reconstruct from right side
4234
4235 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 0, &
4236 & 0)*dvd(1) + poly_coef_cbr_z(j, 0, 1)*dvd(0)
4237 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 1, &
4238 & 0)*dvd(0) + poly_coef_cbr_z(j, 1, 1)*dvd(-1)
4239 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 2, &
4240 & 0)*dvd(-1) + poly_coef_cbr_z(j, 2, 1)*dvd(-2)
4241
4242 if (wenojs) then
4243 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
4244 & j)/(beta(0:weno_num_stencils)**2._wp)
4245 else if (mapped_weno) then
4246 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
4247 & j)/(beta(0:weno_num_stencils)**2._wp)
4248 omega = alpha/sum(alpha)
4249 alpha(0:weno_num_stencils) = (d_cbr_z(0:weno_num_stencils, &
4250 & j)*(1._wp + d_cbr_z(0:weno_num_stencils, &
4251 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4252 & *(omega(0:weno_num_stencils)/(d_cbr_z(0:weno_num_stencils, &
4253 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4254 & - 2._wp*d_cbr_z(0:weno_num_stencils,j))))
4255 else if (wenoz) then
4256
4257# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4258#if defined(MFC_OpenACC)
4259# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4260!$acc loop seq
4261# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4262#elif defined(MFC_OpenMP)
4263# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4264
4265# 1130 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4266#endif
4267 do q = 0, weno_num_stencils
4268 alpha(q) = d_cbr_z(q, j)*(1._wp + (tau/beta(q)))
4269 end do
4270 else if (teno) then
4271
4272# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4273#if defined(MFC_OpenACC)
4274# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4275!$acc loop seq
4276# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4277#elif defined(MFC_OpenMP)
4278# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4279
4280# 1135 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4281#endif
4282 do q = 0, weno_num_stencils
4283 alpha(q) = delta(q)*d_cbr_z(q, j)
4284 end do
4285 end if
4286
4287 omega = alpha/sum(alpha)
4288
4289 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4290 end do
4291 end do
4292 end do
4293 end do
4294
4295# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4296#if defined(MFC_OpenACC)
4297# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4298!$acc end parallel loop
4299# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4300#elif defined(MFC_OpenMP)
4301# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4302
4303# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4304!$omp end target teams loop
4305# 1148 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4306#endif
4307
4308 if (mp_weno) then
4309 call s_preserve_monotonicity(v_rs_ws_z, vl_rs_vf_z, vr_rs_vf_z)
4310 end if
4311 end if
4312# 1155 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4313# 1156 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4314 end if
4315 if (weno_order == 7 .or. dummy) then
4316# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4317# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4318 if (weno_dir == 1) then
4319
4320# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4321
4322# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4323#if defined(MFC_OpenACC)
4324# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4325!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4326# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4327#elif defined(MFC_OpenMP)
4328# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4329
4330# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4331
4332# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4333
4334# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4335!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4336# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4337#endif
4338 do l = is3_weno%beg, is3_weno%end
4339 do k = is2_weno%beg, is2_weno%end
4340 do j = is1_weno%beg, is1_weno%end
4341
4342# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4343#if defined(MFC_OpenACC)
4344# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4345!$acc loop seq
4346# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4347#elif defined(MFC_OpenMP)
4348# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4349
4350# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4351#endif
4352 do i = 1, v_size
4353 alpha(:) = 0._wp
4354 omega(:) = 0._wp
4355 delta(:) = 0._wp
4356 beta(:) = weno_eps
4357
4358 if (teno) v = v_rs_ws_x(j - 3:j + 3,k, l, &
4359 & i) ! temporary field value array for clarity
4360
4361 if (.not. teno) then
4362 dvd(2) = v_rs_ws_x(j + 3, k, l, i) - v_rs_ws_x(j + 2, k, l, i)
4363 dvd(1) = v_rs_ws_x(j + 2, k, l, i) - v_rs_ws_x(j + 1, k, l, i)
4364 dvd(0) = v_rs_ws_x(j + 1, k, l, i) - v_rs_ws_x(j, k, l, i)
4365 dvd(-1) = v_rs_ws_x(j, k, l, i) - v_rs_ws_x(j - 1, k, l, i)
4366 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) - v_rs_ws_x(j - 2, k, l, i)
4367 dvd(-3) = v_rs_ws_x(j - 2, k, l, i) - v_rs_ws_x(j - 3, k, l, i)
4368
4369 poly(3) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 0, &
4370 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, 1)*dvd(1) + poly_coef_cbl_x(j, &
4371 & 0, 2)*dvd(0)
4372 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 1, &
4373 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, 1)*dvd(0) + poly_coef_cbl_x(j, &
4374 & 1, 2)*dvd(-1)
4375 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 2, &
4376 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4377 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4378 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 3, &
4379 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4380 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4381 else
4382# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4383 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4384 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4385 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4386 ! to keep the stencil order to reuse the beta coefficients
4387 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4388 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4389 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4390 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4391 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4392# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4393 end if
4394
4395 if (.not. teno) then
4396 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, 0, &
4397 & 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4398 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4399 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4400 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4401
4402 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, 1, &
4403 & 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4404 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4405 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4406 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4407
4408 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, 2, &
4409 & 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4410 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4411 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4412 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4413
4414 beta(0) = beta_coef_x(j, 3, 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4415 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4416 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4417 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4418 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4419 else ! TENO
4420# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4421 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4422 ! & Tang, 2019) Section 3.2
4423 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4424 & **2._wp)/4._wp + weno_eps
4425 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4426 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4427 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4428 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4429
4430 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4431 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4432 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4433
4434 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4435 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4436 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4437# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4438 end if
4439
4440 if (wenojs) then
4441 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
4442 & j)/(beta(0:weno_num_stencils)**2._wp)
4443 else if (mapped_weno) then
4444 alpha(0:weno_num_stencils) = d_cbl_x(0:weno_num_stencils, &
4445 & j)/(beta(0:weno_num_stencils)**2._wp)
4446 omega = alpha/sum(alpha)
4447 alpha(0:weno_num_stencils) = (d_cbl_x(0:weno_num_stencils, &
4448 & j)*(1._wp + d_cbl_x(0:weno_num_stencils, &
4449 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4450 & *(omega(0:weno_num_stencils)/(d_cbl_x(0:weno_num_stencils, &
4451 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4452 & - 2._wp*d_cbl_x(0:weno_num_stencils,j))))
4453 else if (wenoz) then
4454 ! Castro, et al. (2010) Don & Borges (2013) also helps
4455 tau = abs(beta(3) - beta(0)) ! Equation 50
4456
4457# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4458#if defined(MFC_OpenACC)
4459# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4460!$acc loop seq
4461# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4462#elif defined(MFC_OpenMP)
4463# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4464
4465# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4466#endif
4467 do q = 0, weno_num_stencils
4468 alpha(q) = d_cbl_x(q, &
4469 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4470 end do
4471 else if (teno) then
4472# 1277 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4473 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4474 alpha = 1._wp + tau/beta
4475 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4476 omega = alpha/sum(alpha)
4477
4478
4479# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4480#if defined(MFC_OpenACC)
4481# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4482!$acc loop seq
4483# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4484#elif defined(MFC_OpenMP)
4485# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4486
4487# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4488#endif
4489 do q = 0, weno_num_stencils
4490 if (omega(q) < teno_ct) then ! Equation 26
4491 delta(q) = 0._wp
4492 else
4493 delta(q) = 1._wp
4494 end if
4495 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4496 end do
4497# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4498 end if
4499
4500 omega = alpha/sum(alpha)
4501
4502 vl_rs_vf_x(j, k, l, &
4503 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4504 & *poly(3)
4505
4506 if (teno) then
4507# 1302 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4508 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4509# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4510 end if
4511
4512 if (.not. teno) then
4513 poly(3) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 0, &
4514 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, 1)*dvd(1) + poly_coef_cbr_x(j, &
4515 & 0, 2)*dvd(0)
4516 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 1, &
4517 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, 1)*dvd(0) + poly_coef_cbr_x(j, &
4518 & 1, 2)*dvd(-1)
4519 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 2, &
4520 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4521 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4522 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 3, &
4523 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4524 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4525 else
4526# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4527 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4528 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4529 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4530 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4531 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4532# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4533 end if
4534
4535 if (wenojs) then
4536 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
4537 & j)/(beta(0:weno_num_stencils)**2._wp)
4538 else if (mapped_weno) then
4539 alpha(0:weno_num_stencils) = d_cbr_x(0:weno_num_stencils, &
4540 & j)/(beta(0:weno_num_stencils)**2._wp)
4541 omega = alpha/sum(alpha)
4542 alpha(0:weno_num_stencils) = (d_cbr_x(0:weno_num_stencils, &
4543 & j)*(1._wp + d_cbr_x(0:weno_num_stencils, &
4544 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4545 & *(omega(0:weno_num_stencils)/(d_cbr_x(0:weno_num_stencils, &
4546 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4547 & - 2._wp*d_cbr_x(0:weno_num_stencils,j))))
4548 else if (wenoz) then
4549
4550# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4551#if defined(MFC_OpenACC)
4552# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4553!$acc loop seq
4554# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4555#elif defined(MFC_OpenMP)
4556# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4557
4558# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4559#endif
4560 do q = 0, weno_num_stencils
4561 alpha(q) = d_cbr_x(q, &
4562 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4563 end do
4564 else if (teno) then
4565
4566# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4567#if defined(MFC_OpenACC)
4568# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4569!$acc loop seq
4570# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4571#elif defined(MFC_OpenMP)
4572# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4573
4574# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4575#endif
4576 do q = 0, weno_num_stencils
4577 alpha(q) = delta(q)*d_cbr_x(q, j)
4578 end do
4579 end if
4580
4581 omega = alpha/sum(alpha)
4582
4583 vr_rs_vf_x(j, k, l, &
4584 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4585 & *poly(3)
4586
4587 if (teno) then
4588# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4589 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4590# 1365 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4591 end if
4592 end do
4593 end do
4594 end do
4595 end do
4596
4597# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4598#if defined(MFC_OpenACC)
4599# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4600!$acc end parallel loop
4601# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4602#elif defined(MFC_OpenMP)
4603# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4604
4605# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4606!$omp end target teams loop
4607# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4608#endif
4609 end if
4610# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4611 if (weno_dir == 2) then
4612
4613# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4614
4615# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4616#if defined(MFC_OpenACC)
4617# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4618!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4619# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4620#elif defined(MFC_OpenMP)
4621# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4622
4623# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4624
4625# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4626
4627# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4628!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4629# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4630#endif
4631 do l = is3_weno%beg, is3_weno%end
4632 do k = is2_weno%beg, is2_weno%end
4633 do j = is1_weno%beg, is1_weno%end
4634
4635# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4636#if defined(MFC_OpenACC)
4637# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4638!$acc loop seq
4639# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4640#elif defined(MFC_OpenMP)
4641# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4642
4643# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4644#endif
4645 do i = 1, v_size
4646 alpha(:) = 0._wp
4647 omega(:) = 0._wp
4648 delta(:) = 0._wp
4649 beta(:) = weno_eps
4650
4651 if (teno) v = v_rs_ws_y(j - 3:j + 3,k, l, &
4652 & i) ! temporary field value array for clarity
4653
4654 if (.not. teno) then
4655 dvd(2) = v_rs_ws_y(j + 3, k, l, i) - v_rs_ws_y(j + 2, k, l, i)
4656 dvd(1) = v_rs_ws_y(j + 2, k, l, i) - v_rs_ws_y(j + 1, k, l, i)
4657 dvd(0) = v_rs_ws_y(j + 1, k, l, i) - v_rs_ws_y(j, k, l, i)
4658 dvd(-1) = v_rs_ws_y(j, k, l, i) - v_rs_ws_y(j - 1, k, l, i)
4659 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) - v_rs_ws_y(j - 2, k, l, i)
4660 dvd(-3) = v_rs_ws_y(j - 2, k, l, i) - v_rs_ws_y(j - 3, k, l, i)
4661
4662 poly(3) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 0, &
4663 & 0)*dvd(2) + poly_coef_cbl_y(j, 0, 1)*dvd(1) + poly_coef_cbl_y(j, &
4664 & 0, 2)*dvd(0)
4665 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 1, &
4666 & 0)*dvd(1) + poly_coef_cbl_y(j, 1, 1)*dvd(0) + poly_coef_cbl_y(j, &
4667 & 1, 2)*dvd(-1)
4668 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 2, &
4669 & 0)*dvd(0) + poly_coef_cbl_y(j, 2, &
4670 & 1)*dvd(-1) + poly_coef_cbl_y(j, 2, 2)*dvd(-2)
4671 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 3, &
4672 & 0)*dvd(-1) + poly_coef_cbl_y(j, 3, &
4673 & 1)*dvd(-2) + poly_coef_cbl_y(j, 3, 2)*dvd(-3)
4674 else
4675# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4676 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4677 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4678 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4679 ! to keep the stencil order to reuse the beta coefficients
4680 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4681 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4682 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4683 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4684 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4685# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4686 end if
4687
4688 if (.not. teno) then
4689 beta(3) = beta_coef_y(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(j, 0, &
4690 & 1)*dvd(2)*dvd(1) + beta_coef_y(j, 0, &
4691 & 2)*dvd(2)*dvd(0) + beta_coef_y(j, 0, &
4692 & 3)*dvd(1)*dvd(1) + beta_coef_y(j, 0, &
4693 & 4)*dvd(1)*dvd(0) + beta_coef_y(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4694
4695 beta(2) = beta_coef_y(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(j, 1, &
4696 & 1)*dvd(1)*dvd(0) + beta_coef_y(j, 1, &
4697 & 2)*dvd(1)*dvd(-1) + beta_coef_y(j, 1, &
4698 & 3)*dvd(0)*dvd(0) + beta_coef_y(j, 1, &
4699 & 4)*dvd(0)*dvd(-1) + beta_coef_y(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4700
4701 beta(1) = beta_coef_y(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(j, 2, &
4702 & 1)*dvd(0)*dvd(-1) + beta_coef_y(j, 2, &
4703 & 2)*dvd(0)*dvd(-2) + beta_coef_y(j, 2, &
4704 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(j, 2, &
4705 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4706
4707 beta(0) = beta_coef_y(j, 3, 0)*dvd(-1)*dvd(-1) + beta_coef_y(j, 3, &
4708 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(j, 3, &
4709 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(j, 3, &
4710 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(j, 3, &
4711 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4712 else ! TENO
4713# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4714 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4715 ! & Tang, 2019) Section 3.2
4716 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4717 & **2._wp)/4._wp + weno_eps
4718 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4719 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4720 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4721 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4722
4723 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4724 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4725 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4726
4727 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4728 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4729 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4730# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4731 end if
4732
4733 if (wenojs) then
4734 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
4735 & j)/(beta(0:weno_num_stencils)**2._wp)
4736 else if (mapped_weno) then
4737 alpha(0:weno_num_stencils) = d_cbl_y(0:weno_num_stencils, &
4738 & j)/(beta(0:weno_num_stencils)**2._wp)
4739 omega = alpha/sum(alpha)
4740 alpha(0:weno_num_stencils) = (d_cbl_y(0:weno_num_stencils, &
4741 & j)*(1._wp + d_cbl_y(0:weno_num_stencils, &
4742 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4743 & *(omega(0:weno_num_stencils)/(d_cbl_y(0:weno_num_stencils, &
4744 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4745 & - 2._wp*d_cbl_y(0:weno_num_stencils,j))))
4746 else if (wenoz) then
4747 ! Castro, et al. (2010) Don & Borges (2013) also helps
4748 tau = abs(beta(3) - beta(0)) ! Equation 50
4749
4750# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4751#if defined(MFC_OpenACC)
4752# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4753!$acc loop seq
4754# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4755#elif defined(MFC_OpenMP)
4756# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4757
4758# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4759#endif
4760 do q = 0, weno_num_stencils
4761 alpha(q) = d_cbl_y(q, &
4762 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4763 end do
4764 else if (teno) then
4765# 1277 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4766 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4767 alpha = 1._wp + tau/beta
4768 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4769 omega = alpha/sum(alpha)
4770
4771
4772# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4773#if defined(MFC_OpenACC)
4774# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4775!$acc loop seq
4776# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4777#elif defined(MFC_OpenMP)
4778# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4779
4780# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4781#endif
4782 do q = 0, weno_num_stencils
4783 if (omega(q) < teno_ct) then ! Equation 26
4784 delta(q) = 0._wp
4785 else
4786 delta(q) = 1._wp
4787 end if
4788 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
4789 end do
4790# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4791 end if
4792
4793 omega = alpha/sum(alpha)
4794
4795 vl_rs_vf_y(j, k, l, &
4796 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4797 & *poly(3)
4798
4799 if (teno) then
4800# 1302 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4801 vl_rs_vf_y(j, k, l, i) = vl_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4802# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4803 end if
4804
4805 if (.not. teno) then
4806 poly(3) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 0, &
4807 & 0)*dvd(2) + poly_coef_cbr_y(j, 0, 1)*dvd(1) + poly_coef_cbr_y(j, &
4808 & 0, 2)*dvd(0)
4809 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 1, &
4810 & 0)*dvd(1) + poly_coef_cbr_y(j, 1, 1)*dvd(0) + poly_coef_cbr_y(j, &
4811 & 1, 2)*dvd(-1)
4812 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 2, &
4813 & 0)*dvd(0) + poly_coef_cbr_y(j, 2, &
4814 & 1)*dvd(-1) + poly_coef_cbr_y(j, 2, 2)*dvd(-2)
4815 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 3, &
4816 & 0)*dvd(-1) + poly_coef_cbr_y(j, 3, &
4817 & 1)*dvd(-2) + poly_coef_cbr_y(j, 3, 2)*dvd(-3)
4818 else
4819# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4820 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4821 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4822 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4823 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4824 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4825# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4826 end if
4827
4828 if (wenojs) then
4829 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
4830 & j)/(beta(0:weno_num_stencils)**2._wp)
4831 else if (mapped_weno) then
4832 alpha(0:weno_num_stencils) = d_cbr_y(0:weno_num_stencils, &
4833 & j)/(beta(0:weno_num_stencils)**2._wp)
4834 omega = alpha/sum(alpha)
4835 alpha(0:weno_num_stencils) = (d_cbr_y(0:weno_num_stencils, &
4836 & j)*(1._wp + d_cbr_y(0:weno_num_stencils, &
4837 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
4838 & *(omega(0:weno_num_stencils)/(d_cbr_y(0:weno_num_stencils, &
4839 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
4840 & - 2._wp*d_cbr_y(0:weno_num_stencils,j))))
4841 else if (wenoz) then
4842
4843# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4844#if defined(MFC_OpenACC)
4845# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4846!$acc loop seq
4847# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4848#elif defined(MFC_OpenMP)
4849# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4850
4851# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4852#endif
4853 do q = 0, weno_num_stencils
4854 alpha(q) = d_cbr_y(q, &
4855 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4856 end do
4857 else if (teno) then
4858
4859# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4860#if defined(MFC_OpenACC)
4861# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4862!$acc loop seq
4863# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4864#elif defined(MFC_OpenMP)
4865# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4866
4867# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4868#endif
4869 do q = 0, weno_num_stencils
4870 alpha(q) = delta(q)*d_cbr_y(q, j)
4871 end do
4872 end if
4873
4874 omega = alpha/sum(alpha)
4875
4876 vr_rs_vf_y(j, k, l, &
4877 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4878 & *poly(3)
4879
4880 if (teno) then
4881# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4882 vr_rs_vf_y(j, k, l, i) = vr_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4883# 1365 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4884 end if
4885 end do
4886 end do
4887 end do
4888 end do
4889
4890# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4891#if defined(MFC_OpenACC)
4892# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4893!$acc end parallel loop
4894# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4895#elif defined(MFC_OpenMP)
4896# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4897
4898# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4899!$omp end target teams loop
4900# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4901#endif
4902 end if
4903# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4904 if (weno_dir == 3) then
4905
4906# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4907
4908# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4909#if defined(MFC_OpenACC)
4910# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4911!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4912# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4913#elif defined(MFC_OpenMP)
4914# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4915
4916# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4917
4918# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4919
4920# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4921!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4922# 1161 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4923#endif
4924 do l = is3_weno%beg, is3_weno%end
4925 do k = is2_weno%beg, is2_weno%end
4926 do j = is1_weno%beg, is1_weno%end
4927
4928# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4929#if defined(MFC_OpenACC)
4930# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4931!$acc loop seq
4932# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4933#elif defined(MFC_OpenMP)
4934# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4935
4936# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4937#endif
4938 do i = 1, v_size
4939 alpha(:) = 0._wp
4940 omega(:) = 0._wp
4941 delta(:) = 0._wp
4942 beta(:) = weno_eps
4943
4944 if (teno) v = v_rs_ws_z(j - 3:j + 3,k, l, &
4945 & i) ! temporary field value array for clarity
4946
4947 if (.not. teno) then
4948 dvd(2) = v_rs_ws_z(j + 3, k, l, i) - v_rs_ws_z(j + 2, k, l, i)
4949 dvd(1) = v_rs_ws_z(j + 2, k, l, i) - v_rs_ws_z(j + 1, k, l, i)
4950 dvd(0) = v_rs_ws_z(j + 1, k, l, i) - v_rs_ws_z(j, k, l, i)
4951 dvd(-1) = v_rs_ws_z(j, k, l, i) - v_rs_ws_z(j - 1, k, l, i)
4952 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) - v_rs_ws_z(j - 2, k, l, i)
4953 dvd(-3) = v_rs_ws_z(j - 2, k, l, i) - v_rs_ws_z(j - 3, k, l, i)
4954
4955 poly(3) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 0, &
4956 & 0)*dvd(2) + poly_coef_cbl_z(j, 0, 1)*dvd(1) + poly_coef_cbl_z(j, &
4957 & 0, 2)*dvd(0)
4958 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 1, &
4959 & 0)*dvd(1) + poly_coef_cbl_z(j, 1, 1)*dvd(0) + poly_coef_cbl_z(j, &
4960 & 1, 2)*dvd(-1)
4961 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 2, &
4962 & 0)*dvd(0) + poly_coef_cbl_z(j, 2, &
4963 & 1)*dvd(-1) + poly_coef_cbl_z(j, 2, 2)*dvd(-2)
4964 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 3, &
4965 & 0)*dvd(-1) + poly_coef_cbl_z(j, 3, &
4966 & 1)*dvd(-2) + poly_coef_cbl_z(j, 3, 2)*dvd(-3)
4967 else
4968# 1197 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4969 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4970 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4971 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4972 ! to keep the stencil order to reuse the beta coefficients
4973 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4974 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4975 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4976 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4977 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4978# 1207 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4979 end if
4980
4981 if (.not. teno) then
4982 beta(3) = beta_coef_z(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(j, 0, &
4983 & 1)*dvd(2)*dvd(1) + beta_coef_z(j, 0, &
4984 & 2)*dvd(2)*dvd(0) + beta_coef_z(j, 0, &
4985 & 3)*dvd(1)*dvd(1) + beta_coef_z(j, 0, &
4986 & 4)*dvd(1)*dvd(0) + beta_coef_z(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4987
4988 beta(2) = beta_coef_z(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(j, 1, &
4989 & 1)*dvd(1)*dvd(0) + beta_coef_z(j, 1, &
4990 & 2)*dvd(1)*dvd(-1) + beta_coef_z(j, 1, &
4991 & 3)*dvd(0)*dvd(0) + beta_coef_z(j, 1, &
4992 & 4)*dvd(0)*dvd(-1) + beta_coef_z(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4993
4994 beta(1) = beta_coef_z(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(j, 2, &
4995 & 1)*dvd(0)*dvd(-1) + beta_coef_z(j, 2, &
4996 & 2)*dvd(0)*dvd(-2) + beta_coef_z(j, 2, &
4997 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(j, 2, &
4998 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4999
5000 beta(0) = beta_coef_z(j, 3, 0)*dvd(-1)*dvd(-1) + beta_coef_z(j, 3, &
5001 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(j, 3, &
5002 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(j, 3, &
5003 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(j, 3, &
5004 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5005 else ! TENO
5006# 1235 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5007 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5008 ! & Tang, 2019) Section 3.2
5009 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5010 & **2._wp)/4._wp + weno_eps
5011 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5012 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5013 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5014 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5015
5016 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5017 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5018 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5019
5020 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5021 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5022 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5023# 1252 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5024 end if
5025
5026 if (wenojs) then
5027 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
5028 & j)/(beta(0:weno_num_stencils)**2._wp)
5029 else if (mapped_weno) then
5030 alpha(0:weno_num_stencils) = d_cbl_z(0:weno_num_stencils, &
5031 & j)/(beta(0:weno_num_stencils)**2._wp)
5032 omega = alpha/sum(alpha)
5033 alpha(0:weno_num_stencils) = (d_cbl_z(0:weno_num_stencils, &
5034 & j)*(1._wp + d_cbl_z(0:weno_num_stencils, &
5035 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
5036 & *(omega(0:weno_num_stencils)/(d_cbl_z(0:weno_num_stencils, &
5037 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
5038 & - 2._wp*d_cbl_z(0:weno_num_stencils,j))))
5039 else if (wenoz) then
5040 ! Castro, et al. (2010) Don & Borges (2013) also helps
5041 tau = abs(beta(3) - beta(0)) ! Equation 50
5042
5043# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5044#if defined(MFC_OpenACC)
5045# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5046!$acc loop seq
5047# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5048#elif defined(MFC_OpenMP)
5049# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5050
5051# 1270 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5052#endif
5053 do q = 0, weno_num_stencils
5054 alpha(q) = d_cbl_z(q, &
5055 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
5056 end do
5057 else if (teno) then
5058# 1277 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5059 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5060 alpha = 1._wp + tau/beta
5061 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5062 omega = alpha/sum(alpha)
5063
5064
5065# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5066#if defined(MFC_OpenACC)
5067# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5068!$acc loop seq
5069# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5070#elif defined(MFC_OpenMP)
5071# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5072
5073# 1282 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5074#endif
5075 do q = 0, weno_num_stencils
5076 if (omega(q) < teno_ct) then ! Equation 26
5077 delta(q) = 0._wp
5078 else
5079 delta(q) = 1._wp
5080 end if
5081 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
5082 end do
5083# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5084 end if
5085
5086 omega = alpha/sum(alpha)
5087
5088 vl_rs_vf_z(j, k, l, &
5089 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
5090 & *poly(3)
5091
5092 if (teno) then
5093# 1302 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5094 vl_rs_vf_z(j, k, l, i) = vl_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
5095# 1304 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5096 end if
5097
5098 if (.not. teno) then
5099 poly(3) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 0, &
5100 & 0)*dvd(2) + poly_coef_cbr_z(j, 0, 1)*dvd(1) + poly_coef_cbr_z(j, &
5101 & 0, 2)*dvd(0)
5102 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 1, &
5103 & 0)*dvd(1) + poly_coef_cbr_z(j, 1, 1)*dvd(0) + poly_coef_cbr_z(j, &
5104 & 1, 2)*dvd(-1)
5105 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 2, &
5106 & 0)*dvd(0) + poly_coef_cbr_z(j, 2, &
5107 & 1)*dvd(-1) + poly_coef_cbr_z(j, 2, 2)*dvd(-2)
5108 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 3, &
5109 & 0)*dvd(-1) + poly_coef_cbr_z(j, 3, &
5110 & 1)*dvd(-2) + poly_coef_cbr_z(j, 3, 2)*dvd(-3)
5111 else
5112# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5113 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5114 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5115 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5116 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5117 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5118# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5119 end if
5120
5121 if (wenojs) then
5122 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
5123 & j)/(beta(0:weno_num_stencils)**2._wp)
5124 else if (mapped_weno) then
5125 alpha(0:weno_num_stencils) = d_cbr_z(0:weno_num_stencils, &
5126 & j)/(beta(0:weno_num_stencils)**2._wp)
5127 omega = alpha/sum(alpha)
5128 alpha(0:weno_num_stencils) = (d_cbr_z(0:weno_num_stencils, &
5129 & j)*(1._wp + d_cbr_z(0:weno_num_stencils, &
5130 & j) - 3._wp*omega(0:weno_num_stencils)) + omega(0:weno_num_stencils)**2._wp) &
5131 & *(omega(0:weno_num_stencils)/(d_cbr_z(0:weno_num_stencils, &
5132 & j)**2._wp + omega(0:weno_num_stencils)*(1._wp &
5133 & - 2._wp*d_cbr_z(0:weno_num_stencils,j))))
5134 else if (wenoz) then
5135
5136# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5137#if defined(MFC_OpenACC)
5138# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5139!$acc loop seq
5140# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5141#elif defined(MFC_OpenMP)
5142# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5143
5144# 1343 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5145#endif
5146 do q = 0, weno_num_stencils
5147 alpha(q) = d_cbr_z(q, &
5148 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
5149 end do
5150 else if (teno) then
5151
5152# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5153#if defined(MFC_OpenACC)
5154# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5155!$acc loop seq
5156# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5157#elif defined(MFC_OpenMP)
5158# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5159
5160# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5161#endif
5162 do q = 0, weno_num_stencils
5163 alpha(q) = delta(q)*d_cbr_z(q, j)
5164 end do
5165 end if
5166
5167 omega = alpha/sum(alpha)
5168
5169 vr_rs_vf_z(j, k, l, &
5170 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
5171 & *poly(3)
5172
5173 if (teno) then
5174# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5175 vr_rs_vf_z(j, k, l, i) = vr_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
5176# 1365 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5177 end if
5178 end do
5179 end do
5180 end do
5181 end do
5182
5183# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5184#if defined(MFC_OpenACC)
5185# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5186!$acc end parallel loop
5187# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5188#elif defined(MFC_OpenMP)
5189# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5190
5191# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5192!$omp end target teams loop
5193# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5194#endif
5195 end if
5196# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5197# 1374 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5198 end if
5199
5200 if (int_comp) then
5201 call s_interface_compression(vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, weno_dir, &
5202 & is1_weno_d, is2_weno_d, is3_weno_d)
5203 end if
5204
5205 end subroutine s_weno
5206
5207 !> Set up the WENO reconstruction for a given direction
5208 subroutine s_initialize_weno(v_vf, weno_dir)
5209
5210 type(scalar_field), dimension(:), intent(in) :: v_vf
5211 integer, intent(in) :: weno_dir
5212 integer :: j, k, l, q
5213
5214 ! Determine WENO-reconstructed variables and map coordinate directions
5215
5216 v_size = ubound(v_vf, 1)
5217
5218# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219#if defined(MFC_OpenACC)
5220# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5221!$acc update device(v_size)
5222# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5223#elif defined(MFC_OpenMP)
5224# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5225!$omp target update to(v_size)
5226# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5227#endif
5228
5229 if (weno_dir == 1) then
5230
5231# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5232
5233# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5234#if defined(MFC_OpenACC)
5235# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5236!$acc parallel loop collapse(4) gang vector default(present)
5237# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5238#elif defined(MFC_OpenMP)
5239# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5240
5241# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5242
5243# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5244
5245# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5246!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5247# 1396 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5248#endif
5249 do j = 1, v_size
5250 do q = is3_weno%beg, is3_weno%end
5251 do l = is2_weno%beg, is2_weno%end
5252 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
5253 v_rs_ws_x(k, l, q, j) = v_vf(j)%sf(k, l, q)
5254 end do
5255 end do
5256 end do
5257 end do
5258
5259# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5260#if defined(MFC_OpenACC)
5261# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5262!$acc end parallel loop
5263# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5264#elif defined(MFC_OpenMP)
5265# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5266
5267# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5268!$omp end target teams loop
5269# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5270#endif
5271 end if
5272
5273 ! Reshaping/Projecting onto Characteristic Fields in y-direction
5274 if (n == 0) return
5275
5276 if (weno_dir == 2) then
5277
5278# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5279
5280# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5281#if defined(MFC_OpenACC)
5282# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5283!$acc parallel loop collapse(4) gang vector default(present)
5284# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5285#elif defined(MFC_OpenMP)
5286# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5287
5288# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5289
5290# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5291
5292# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5293!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5294# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5295#endif
5296 do j = 1, v_size
5297 do q = is3_weno%beg, is3_weno%end
5298 do l = is2_weno%beg, is2_weno%end
5299 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
5300 v_rs_ws_y(k, l, q, j) = v_vf(j)%sf(l, k, q)
5301 end do
5302 end do
5303 end do
5304 end do
5305
5306# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5307#if defined(MFC_OpenACC)
5308# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5309!$acc end parallel loop
5310# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5311#elif defined(MFC_OpenMP)
5312# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5313
5314# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5315!$omp end target teams loop
5316# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5317#endif
5318 end if
5319
5320 ! Reshaping/Projecting onto Characteristic Fields in z-direction
5321 if (p == 0) return
5322
5323 if (weno_dir == 3) then
5324
5325# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5326
5327# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5328#if defined(MFC_OpenACC)
5329# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5330!$acc parallel loop collapse(4) gang vector default(present)
5331# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5332#elif defined(MFC_OpenMP)
5333# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5334
5335# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5336
5337# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5338
5339# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5340!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5341# 1430 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5342#endif
5343 do j = 1, v_size
5344 do q = is3_weno%beg, is3_weno%end
5345 do l = is2_weno%beg, is2_weno%end
5346 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
5347 v_rs_ws_z(k, l, q, j) = v_vf(j)%sf(q, l, k)
5348 end do
5349 end do
5350 end do
5351 end do
5352
5353# 1440 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5354#if defined(MFC_OpenACC)
5355# 1440 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5356!$acc end parallel loop
5357# 1440 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5358#elif defined(MFC_OpenMP)
5359# 1440 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5360
5361# 1440 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5362!$omp end target teams loop
5363# 1440 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5364#endif
5365 end if
5366
5367 end subroutine s_initialize_weno
5368
5369 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5370 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf)
5371
5372 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5373 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5374 integer :: i, j, k, l
5375 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5376 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5377 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5378 ! the cell- average variables.
5379 real(wp) :: vL_UL, vR_UL
5380 real(wp) :: vL_MD, vR_MD
5381 real(wp) :: vL_LC, vR_LC
5382 real(wp) :: vL_min, vR_min
5383 real(wp) :: vL_max, vR_max
5384 ! Monotonicity-preserving bounds, Suresh & Huynh JCP (1997)
5385 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5386 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5387 real(wp), parameter :: alpha_mp = 2._wp
5388 real(wp), parameter :: beta_mp = 4._wp/3._wp
5389
5390
5391# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5392
5393# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5394#if defined(MFC_OpenACC)
5395# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5396!$acc parallel loop collapse(4) gang vector default(present) private(d)
5397# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5398#elif defined(MFC_OpenMP)
5399# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5400
5401# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5402
5403# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5404
5405# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5406!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d)
5407# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5408#endif
5409 do l = is3_weno%beg, is3_weno%end
5410 do k = is2_weno%beg, is2_weno%end
5411 do j = is1_weno%beg, is1_weno%end
5412 do i = 1, v_size
5413 ! Second-order undivided differences for curvature estimation
5414 d(-1) = v_rs_ws(j, k, l, i) + v_rs_ws(j - 2, k, l, i) - v_rs_ws(j - 1, k, l, i)*2._wp
5415 d(0) = v_rs_ws(j + 1, k, l, i) + v_rs_ws(j - 1, k, l, i) - v_rs_ws(j, k, l, i)*2._wp
5416 d(1) = v_rs_ws(j + 2, k, l, i) + v_rs_ws(j, k, l, i) - v_rs_ws(j + 1, k, l, i)*2._wp
5417
5418 ! Median function for oscillation detection
5419 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5420 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, &
5421 & d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5422
5423 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5424 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5425 & 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
5426
5427 vl_ul = v_rs_ws(j, k, l, i) - (v_rs_ws(j + 1, k, l, i) - v_rs_ws(j, k, l, i))*alpha_mp
5428
5429 vl_md = (v_rs_ws(j, k, l, i) + v_rs_ws(j - 1, k, l, i) - d_md)*5.e-1_wp
5430
5431 vl_lc = v_rs_ws(j, k, l, i) - (v_rs_ws(j + 1, k, l, i) - v_rs_ws(j, k, l, i))*5.e-1_wp + beta_mp*d_lc
5432
5433 vl_min = max(min(v_rs_ws(j, k, l, i), v_rs_ws(j - 1, k, l, i), vl_md), min(v_rs_ws(j, k, l, i), vl_ul, &
5434 & vl_lc))
5435
5436 vl_max = min(max(v_rs_ws(j, k, l, i), v_rs_ws(j - 1, k, l, i), vl_md), max(v_rs_ws(j, k, l, i), vl_ul, &
5437 & vl_lc))
5438
5439 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, &
5440 & i)) + sign(5.e-1_wp, vl_max - vl_rs_vf(j, k, l, i)))*min(abs(vl_min - vl_rs_vf(j, k, l, i)), &
5441 & abs(vl_max - vl_rs_vf(j, k, l, i)))
5442 ! END: Left Monotonicity Preserving Bound
5443
5444 ! Right Monotonicity Preserving Bound
5445 d(-1) = v_rs_ws(j, k, l, i) + v_rs_ws(j - 2, k, l, i) - v_rs_ws(j - 1, k, l, i)*2._wp
5446 d(0) = v_rs_ws(j + 1, k, l, i) + v_rs_ws(j - 1, k, l, i) - v_rs_ws(j, k, l, i)*2._wp
5447 d(1) = v_rs_ws(j + 2, k, l, i) + v_rs_ws(j, k, l, i) - v_rs_ws(j + 1, k, l, i)*2._wp
5448
5449 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5450 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5451 & 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
5452
5453 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5454 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, &
5455 & d(0))))*min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp
5456
5457 vr_ul = v_rs_ws(j, k, l, i) + (v_rs_ws(j, k, l, i) - v_rs_ws(j - 1, k, l, i))*alpha_mp
5458
5459 vr_md = (v_rs_ws(j, k, l, i) + v_rs_ws(j + 1, k, l, i) - d_md)*5.e-1_wp
5460
5461 vr_lc = v_rs_ws(j, k, l, i) + (v_rs_ws(j, k, l, i) - v_rs_ws(j - 1, k, l, i))*5.e-1_wp + beta_mp*d_lc
5462
5463 vr_min = max(min(v_rs_ws(j, k, l, i), v_rs_ws(j + 1, k, l, i), vr_md), min(v_rs_ws(j, k, l, i), vr_ul, &
5464 & vr_lc))
5465
5466 vr_max = min(max(v_rs_ws(j, k, l, i), v_rs_ws(j + 1, k, l, i), vr_md), max(v_rs_ws(j, k, l, i), vr_ul, &
5467 & vr_lc))
5468
5469 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, &
5470 & i)) + sign(5.e-1_wp, vr_max - vr_rs_vf(j, k, l, i)))*min(abs(vr_min - vr_rs_vf(j, k, l, i)), &
5471 & abs(vr_max - vr_rs_vf(j, k, l, i)))
5472 ! END: Right Monotonicity Preserving Bound
5473 end do
5474 end do
5475 end do
5476 end do
5477
5478# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5479#if defined(MFC_OpenACC)
5480# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5481!$acc end parallel loop
5482# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5483#elif defined(MFC_OpenMP)
5484# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5485
5486# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5487!$omp end target teams loop
5488# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5489#endif
5490
5491 end subroutine s_preserve_monotonicity
5492
5493 !> Module deallocation and/or disassociation procedures
5494 impure subroutine s_finalize_weno_module()
5495
5496 if (weno_order == 1) return
5497
5498 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5499
5500#ifdef MFC_DEBUG
5501# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5502 block
5503# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5504 use iso_fortran_env, only: output_unit
5505# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5506
5507# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5508 print *, 'm_weno.fpp:1546: ', '@:DEALLOCATE(v_rs_ws_x)'
5509# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5510
5511# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5512 call flush (output_unit)
5513# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5514 end block
5515# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5516#endif
5517# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5518
5519# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5520#if defined(MFC_OpenACC)
5521# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5522!$acc exit data delete(v_rs_ws_x)
5523# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5524#elif defined(MFC_OpenMP)
5525# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5526!$omp target exit data map(release:v_rs_ws_x)
5527# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5528#endif
5529# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5530 deallocate (v_rs_ws_x)
5531
5532 ! Deallocating WENO coefficients in x-direction
5533#ifdef MFC_DEBUG
5534# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5535 block
5536# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5537 use iso_fortran_env, only: output_unit
5538# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5539
5540# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5541 print *, 'm_weno.fpp:1549: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5542# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5543
5544# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5545 call flush (output_unit)
5546# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5547 end block
5548# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5549#endif
5550# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5551
5552# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5553#if defined(MFC_OpenACC)
5554# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5555!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5556# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5557#elif defined(MFC_OpenMP)
5558# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5559!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5560# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5561#endif
5562# 1549 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5563 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5564#ifdef MFC_DEBUG
5565# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5566 block
5567# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5568 use iso_fortran_env, only: output_unit
5569# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5570
5571# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5572 print *, 'm_weno.fpp:1550: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5573# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5574
5575# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5576 call flush (output_unit)
5577# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5578 end block
5579# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5580#endif
5581# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5582
5583# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5584#if defined(MFC_OpenACC)
5585# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5586!$acc exit data delete(d_cbL_x, d_cbR_x)
5587# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5588#elif defined(MFC_OpenMP)
5589# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5590!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5591# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5592#endif
5593# 1550 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5594 deallocate (d_cbl_x, d_cbr_x)
5595#ifdef MFC_DEBUG
5596# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5597 block
5598# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5599 use iso_fortran_env, only: output_unit
5600# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5601
5602# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5603 print *, 'm_weno.fpp:1551: ', '@:DEALLOCATE(beta_coef_x)'
5604# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5605
5606# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5607 call flush (output_unit)
5608# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5609 end block
5610# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5611#endif
5612# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5613
5614# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5615#if defined(MFC_OpenACC)
5616# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5617!$acc exit data delete(beta_coef_x)
5618# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5619#elif defined(MFC_OpenMP)
5620# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5621!$omp target exit data map(release:beta_coef_x)
5622# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5623#endif
5624# 1551 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5625 deallocate (beta_coef_x)
5626
5627 ! Deallocating WENO coefficients in y-direction
5628 if (n == 0) return
5629
5630#ifdef MFC_DEBUG
5631# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5632 block
5633# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5634 use iso_fortran_env, only: output_unit
5635# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5636
5637# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5638 print *, 'm_weno.fpp:1556: ', '@:DEALLOCATE(v_rs_ws_y)'
5639# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5640
5641# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5642 call flush (output_unit)
5643# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5644 end block
5645# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5646#endif
5647# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5648
5649# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5650#if defined(MFC_OpenACC)
5651# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5652!$acc exit data delete(v_rs_ws_y)
5653# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5654#elif defined(MFC_OpenMP)
5655# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5656!$omp target exit data map(release:v_rs_ws_y)
5657# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5658#endif
5659# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5660 deallocate (v_rs_ws_y)
5661
5662#ifdef MFC_DEBUG
5663# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5664 block
5665# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5666 use iso_fortran_env, only: output_unit
5667# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5668
5669# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5670 print *, 'm_weno.fpp:1558: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5671# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5672
5673# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5674 call flush (output_unit)
5675# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5676 end block
5677# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5678#endif
5679# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5680
5681# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5682#if defined(MFC_OpenACC)
5683# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5684!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5685# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5686#elif defined(MFC_OpenMP)
5687# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5688!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5689# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5690#endif
5691# 1558 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5692 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5693#ifdef MFC_DEBUG
5694# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5695 block
5696# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5697 use iso_fortran_env, only: output_unit
5698# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5699
5700# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5701 print *, 'm_weno.fpp:1559: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5702# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5703
5704# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5705 call flush (output_unit)
5706# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5707 end block
5708# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5709#endif
5710# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5711
5712# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5713#if defined(MFC_OpenACC)
5714# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5715!$acc exit data delete(d_cbL_y, d_cbR_y)
5716# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5717#elif defined(MFC_OpenMP)
5718# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5719!$omp target exit data map(release:d_cbL_y, d_cbR_y)
5720# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5721#endif
5722# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5723 deallocate (d_cbl_y, d_cbr_y)
5724#ifdef MFC_DEBUG
5725# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5726 block
5727# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5728 use iso_fortran_env, only: output_unit
5729# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5730
5731# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5732 print *, 'm_weno.fpp:1560: ', '@:DEALLOCATE(beta_coef_y)'
5733# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5734
5735# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5736 call flush (output_unit)
5737# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5738 end block
5739# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5740#endif
5741# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5742
5743# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5744#if defined(MFC_OpenACC)
5745# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5746!$acc exit data delete(beta_coef_y)
5747# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5748#elif defined(MFC_OpenMP)
5749# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5750!$omp target exit data map(release:beta_coef_y)
5751# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5752#endif
5753# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5754 deallocate (beta_coef_y)
5755
5756 ! Deallocating WENO coefficients in z-direction
5757 if (p == 0) return
5758
5759#ifdef MFC_DEBUG
5760# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5761 block
5762# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5763 use iso_fortran_env, only: output_unit
5764# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5765
5766# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5767 print *, 'm_weno.fpp:1565: ', '@:DEALLOCATE(v_rs_ws_z)'
5768# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5769
5770# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5771 call flush (output_unit)
5772# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5773 end block
5774# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5775#endif
5776# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5777
5778# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5779#if defined(MFC_OpenACC)
5780# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5781!$acc exit data delete(v_rs_ws_z)
5782# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5783#elif defined(MFC_OpenMP)
5784# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5785!$omp target exit data map(release:v_rs_ws_z)
5786# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5787#endif
5788# 1565 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5789 deallocate (v_rs_ws_z)
5790
5791#ifdef MFC_DEBUG
5792# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5793 block
5794# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5795 use iso_fortran_env, only: output_unit
5796# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5797
5798# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5799 print *, 'm_weno.fpp:1567: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
5800# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5801
5802# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5803 call flush (output_unit)
5804# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5805 end block
5806# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5807#endif
5808# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5809
5810# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5811#if defined(MFC_OpenACC)
5812# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5813!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
5814# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5815#elif defined(MFC_OpenMP)
5816# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5817!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
5818# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5819#endif
5820# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5821 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
5822#ifdef MFC_DEBUG
5823# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5824 block
5825# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5826 use iso_fortran_env, only: output_unit
5827# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5828
5829# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5830 print *, 'm_weno.fpp:1568: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
5831# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5832
5833# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5834 call flush (output_unit)
5835# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5836 end block
5837# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5838#endif
5839# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5840
5841# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5842#if defined(MFC_OpenACC)
5843# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844!$acc exit data delete(d_cbL_z, d_cbR_z)
5845# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5846#elif defined(MFC_OpenMP)
5847# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5848!$omp target exit data map(release:d_cbL_z, d_cbR_z)
5849# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5850#endif
5851# 1568 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5852 deallocate (d_cbl_z, d_cbr_z)
5853#ifdef MFC_DEBUG
5854# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5855 block
5856# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5857 use iso_fortran_env, only: output_unit
5858# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5859
5860# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5861 print *, 'm_weno.fpp:1569: ', '@:DEALLOCATE(beta_coef_z)'
5862# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5863
5864# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5865 call flush (output_unit)
5866# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5867 end block
5868# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5869#endif
5870# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5871
5872# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5873#if defined(MFC_OpenACC)
5874# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5875!$acc exit data delete(beta_coef_z)
5876# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5877#elif defined(MFC_OpenMP)
5878# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879!$omp target exit data map(release:beta_coef_z)
5880# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5881#endif
5882# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5883 deallocate (beta_coef_z)
5884
5885 end subroutine s_finalize_weno_module
5886
5887end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1064
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1064
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1064
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::weno_polyn
integer weno_polyn
Degree of the WENO polynomials (polyn).
Definition m_global_parameters.fpp.f90:445
m_global_parameters::buff_size
integer buff_size
Number of ghost cells for boundary condition storage.
Definition m_global_parameters.fpp.f90:914
m_global_parameters::weno_order
integer weno_order
Order of the WENO reconstruction.
Definition m_global_parameters.fpp.f90:447
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:352
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:352
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:328
m_muscl
MUSCL reconstruction with interface sharpening for contact-preserving advection.
Definition m_muscl.fpp.f90:317
m_muscl::v_size
integer v_size
Definition m_muscl.fpp.f90:331
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_weno
WENO/WENO-Z/TENO reconstruction with optional monotonicity-preserving bounds and mapped weights.
Definition m_weno.fpp.f90:327
m_weno::is2_weno
type(int_bounds_info) is2_weno
Definition m_weno.fpp.f90:455
m_weno::d_cbl_z
real(wp), dimension(:,:), allocatable, target d_cbl_z
Definition m_weno.fpp.f90:401
m_weno::poly_coef_cbl_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_x
Definition m_weno.fpp.f90:365
m_weno::s_initialize_weno_module
impure subroutine, public s_initialize_weno_module
Initialize the WENO module.
Definition m_weno.fpp.f90:476
m_weno::is3_weno
type(int_bounds_info) is3_weno
Definition m_weno.fpp.f90:455
m_weno::d_cbl_y
real(wp), dimension(:,:), allocatable, target d_cbl_y
Definition m_weno.fpp.f90:400
m_weno::beta_coef_y
real(wp), dimension(:,:,:), allocatable, target beta_coef_y
Definition m_weno.fpp.f90:423
m_weno::d_cbr_y
real(wp), dimension(:,:), allocatable, target d_cbr_y
Definition m_weno.fpp.f90:403
m_weno::s_weno
subroutine, public s_weno(v_vf, vl_rs_vf_x, vl_rs_vf_y, vl_rs_vf_z, vr_rs_vf_x, vr_rs_vf_y, vr_rs_vf_z, 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:3152
m_weno::beta_coef_x
real(wp), dimension(:,:,:), allocatable, target beta_coef_x
Definition m_weno.fpp.f90:422
m_weno::beta_coef_z
real(wp), dimension(:,:,:), allocatable, target beta_coef_z
Definition m_weno.fpp.f90:424
m_weno::v_rs_ws_z
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_z
Definition m_weno.fpp.f90:344
m_weno::d_cbr_x
real(wp), dimension(:,:), allocatable, target d_cbr_x
Definition m_weno.fpp.f90:402
m_weno::d_cbr_z
real(wp), dimension(:,:), allocatable, target d_cbr_z
Definition m_weno.fpp.f90:404
m_weno::poly_coef_cbl_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_z
Definition m_weno.fpp.f90:367
m_weno::s_preserve_monotonicity
subroutine s_preserve_monotonicity(v_rs_ws, vl_rs_vf, vr_rs_vf)
Enforce monotonicity-preserving bounds on the WENO reconstruction.
Definition m_weno.fpp.f90:5371
m_weno::poly_coef_cbr_x
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_x
Definition m_weno.fpp.f90:368
m_weno::v_size
integer v_size
Number of WENO-reconstructed cell-average variables.
Definition m_weno.fpp.f90:440
m_weno::v_rs_ws_x
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_x
Definition m_weno.fpp.f90:344
m_weno::d_cbl_x
real(wp), dimension(:,:), allocatable, target d_cbl_x
Definition m_weno.fpp.f90:399
m_weno::is1_weno
type(int_bounds_info) is1_weno
Definition m_weno.fpp.f90:455
m_weno::v_rs_ws_y
real(wp), dimension(:,:,:,:), allocatable v_rs_ws_y
Definition m_weno.fpp.f90:344
m_weno::poly_coef_cbr_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_y
Definition m_weno.fpp.f90:369
m_weno::s_initialize_weno
subroutine, public s_initialize_weno(v_vf, weno_dir)
Set up the WENO reconstruction for a given direction.
Definition m_weno.fpp.f90:5209
m_weno::poly_coef_cbl_y
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbl_y
Definition m_weno.fpp.f90:366
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:1139
m_weno::poly_coef_cbr_z
real(wp), dimension(:,:,:), allocatable, target poly_coef_cbr_z
Definition m_weno.fpp.f90:370
m_weno::s_finalize_weno_module
impure subroutine, public s_finalize_weno_module()
Module deallocation and/or disassociation procedures.
Definition m_weno.fpp.f90:5495
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:405