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, q)
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, q)
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 do q = 0, weno_num_stencils
3366 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3367 end do
3368 else if (mapped_weno) then
3369 do q = 0, weno_num_stencils
3370 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3371 end do
3372 omega = alpha/sum(alpha)
3373 do q = 0, weno_num_stencils
3374 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3375 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3376 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3377 end do
3378 else if (wenoz) then
3379 ! Borges, et al. (2008)
3380 tau = abs(beta(1) - beta(0))
3381 do q = 0, weno_num_stencils
3382 alpha(q) = d_cbl_x(q, j)*(1._wp + tau/beta(q))
3383 end do
3384 end if
3385
3386 omega = alpha/sum(alpha)
3387
3388 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3389
3390 ! reconstruct from right side
3391
3392 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 0, 0)*dvd(0)
3393 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 1, 0)*dvd(-1)
3394
3395 if (wenojs) then
3396 do q = 0, weno_num_stencils
3397 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3398 end do
3399 else if (mapped_weno) then
3400 do q = 0, weno_num_stencils
3401 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3402 end do
3403 omega = alpha/sum(alpha)
3404 do q = 0, weno_num_stencils
3405 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3406 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3407 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3408 end do
3409 else if (wenoz) then
3410 do q = 0, weno_num_stencils
3411 alpha(q) = d_cbr_x(q, j)*(1._wp + tau/beta(q))
3412 end do
3413 end if
3414
3415 omega = alpha/sum(alpha)
3416
3417 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3418 end do
3419 end do
3420 end do
3421 end do
3422
3423# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3424#if defined(MFC_OpenACC)
3425# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3426!$acc end parallel loop
3427# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3428#elif defined(MFC_OpenMP)
3429# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3430
3431# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3432!$omp end target teams loop
3433# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3434#endif
3435 end if
3436# 943 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3437 if (weno_dir == 2) then
3438
3439# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3440
3441# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3442#if defined(MFC_OpenACC)
3443# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3444!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q)
3445# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3446#elif defined(MFC_OpenMP)
3447# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3448
3449# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3450
3451# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3452
3453# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3454!$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, q)
3455# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3456#endif
3457 do l = is3_weno%beg, is3_weno%end
3458 do k = is2_weno%beg, is2_weno%end
3459 do j = is1_weno%beg, is1_weno%end
3460 do i = 1, v_size
3461 ! reconstruct from left side
3462
3463 alpha(:) = 0._wp
3464 omega(:) = 0._wp
3465 beta(:) = weno_eps
3466
3467 dvd(0) = v_rs_ws_y(j + 1, k, l, i) - v_rs_ws_y(j, k, l, i)
3468 dvd(-1) = v_rs_ws_y(j, k, l, i) - v_rs_ws_y(j - 1, k, l, i)
3469
3470 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 0, 0)*dvd(0)
3471 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 1, 0)*dvd(-1)
3472
3473 beta(0) = beta_coef_y(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3474 beta(1) = beta_coef_y(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3475
3476 if (wenojs) then
3477 do q = 0, weno_num_stencils
3478 alpha(q) = d_cbl_y(q, j)/(beta(q)**2._wp)
3479 end do
3480 else if (mapped_weno) then
3481 do q = 0, weno_num_stencils
3482 alpha(q) = d_cbl_y(q, j)/(beta(q)**2._wp)
3483 end do
3484 omega = alpha/sum(alpha)
3485 do q = 0, weno_num_stencils
3486 alpha(q) = (d_cbl_y(q, j)*(1._wp + d_cbl_y(q, &
3487 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3488 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, j))))
3489 end do
3490 else if (wenoz) then
3491 ! Borges, et al. (2008)
3492 tau = abs(beta(1) - beta(0))
3493 do q = 0, weno_num_stencils
3494 alpha(q) = d_cbl_y(q, j)*(1._wp + tau/beta(q))
3495 end do
3496 end if
3497
3498 omega = alpha/sum(alpha)
3499
3500 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3501
3502 ! reconstruct from right side
3503
3504 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 0, 0)*dvd(0)
3505 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 1, 0)*dvd(-1)
3506
3507 if (wenojs) then
3508 do q = 0, weno_num_stencils
3509 alpha(q) = d_cbr_y(q, j)/(beta(q)**2._wp)
3510 end do
3511 else if (mapped_weno) then
3512 do q = 0, weno_num_stencils
3513 alpha(q) = d_cbr_y(q, j)/(beta(q)**2._wp)
3514 end do
3515 omega = alpha/sum(alpha)
3516 do q = 0, weno_num_stencils
3517 alpha(q) = (d_cbr_y(q, j)*(1._wp + d_cbr_y(q, &
3518 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
3519 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, j))))
3520 end do
3521 else if (wenoz) then
3522 do q = 0, weno_num_stencils
3523 alpha(q) = d_cbr_y(q, j)*(1._wp + tau/beta(q))
3524 end do
3525 end if
3526
3527 omega = alpha/sum(alpha)
3528
3529 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3530 end do
3531 end do
3532 end do
3533 end do
3534
3535# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3536#if defined(MFC_OpenACC)
3537# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3538!$acc end parallel loop
3539# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3540#elif defined(MFC_OpenMP)
3541# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3542
3543# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3544!$omp end target teams loop
3545# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3546#endif
3547 end if
3548# 943 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3549 if (weno_dir == 3) then
3550
3551# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3552
3553# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3554#if defined(MFC_OpenACC)
3555# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3556!$acc parallel loop collapse(4) gang vector default(present) private(beta, dvd, poly, omega, alpha, tau, q)
3557# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3558#elif defined(MFC_OpenMP)
3559# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3560
3561# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3562
3563# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3564
3565# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3566!$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, q)
3567# 944 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3568#endif
3569 do l = is3_weno%beg, is3_weno%end
3570 do k = is2_weno%beg, is2_weno%end
3571 do j = is1_weno%beg, is1_weno%end
3572 do i = 1, v_size
3573 ! reconstruct from left side
3574
3575 alpha(:) = 0._wp
3576 omega(:) = 0._wp
3577 beta(:) = weno_eps
3578
3579 dvd(0) = v_rs_ws_z(j + 1, k, l, i) - v_rs_ws_z(j, k, l, i)
3580 dvd(-1) = v_rs_ws_z(j, k, l, i) - v_rs_ws_z(j - 1, k, l, i)
3581
3582 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 0, 0)*dvd(0)
3583 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 1, 0)*dvd(-1)
3584
3585 beta(0) = beta_coef_z(j, 0, 0)*dvd(0)*dvd(0) + weno_eps
3586 beta(1) = beta_coef_z(j, 1, 0)*dvd(-1)*dvd(-1) + weno_eps
3587
3588 if (wenojs) then
3589 do q = 0, weno_num_stencils
3590 alpha(q) = d_cbl_z(q, j)/(beta(q)**2._wp)
3591 end do
3592 else if (mapped_weno) then
3593 do q = 0, weno_num_stencils
3594 alpha(q) = d_cbl_z(q, j)/(beta(q)**2._wp)
3595 end do
3596 omega = alpha/sum(alpha)
3597 do q = 0, weno_num_stencils
3598 alpha(q) = (d_cbl_z(q, j)*(1._wp + d_cbl_z(q, &
3599 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
3600 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, j))))
3601 end do
3602 else if (wenoz) then
3603 ! Borges, et al. (2008)
3604 tau = abs(beta(1) - beta(0))
3605 do q = 0, weno_num_stencils
3606 alpha(q) = d_cbl_z(q, j)*(1._wp + tau/beta(q))
3607 end do
3608 end if
3609
3610 omega = alpha/sum(alpha)
3611
3612 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3613
3614 ! reconstruct from right side
3615
3616 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 0, 0)*dvd(0)
3617 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 1, 0)*dvd(-1)
3618
3619 if (wenojs) then
3620 do q = 0, weno_num_stencils
3621 alpha(q) = d_cbr_z(q, j)/(beta(q)**2._wp)
3622 end do
3623 else if (mapped_weno) then
3624 do q = 0, weno_num_stencils
3625 alpha(q) = d_cbr_z(q, j)/(beta(q)**2._wp)
3626 end do
3627 omega = alpha/sum(alpha)
3628 do q = 0, weno_num_stencils
3629 alpha(q) = (d_cbr_z(q, j)*(1._wp + d_cbr_z(q, &
3630 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
3631 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, j))))
3632 end do
3633 else if (wenoz) then
3634 do q = 0, weno_num_stencils
3635 alpha(q) = d_cbr_z(q, j)*(1._wp + tau/beta(q))
3636 end do
3637 end if
3638
3639 omega = alpha/sum(alpha)
3640
3641 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1)
3642 end do
3643 end do
3644 end do
3645 end do
3646
3647# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3648#if defined(MFC_OpenACC)
3649# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3650!$acc end parallel loop
3651# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3652#elif defined(MFC_OpenMP)
3653# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3654
3655# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3656!$omp end target teams loop
3657# 1022 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3658#endif
3659 end if
3660# 1025 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3661 end if
3662 if (weno_order == 5 .or. dummy) then
3663# 1028 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3664# 1029 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3665 if (weno_dir == 1) then
3666
3667# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3668
3669# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3670#if defined(MFC_OpenACC)
3671# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3672!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3673# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3674#elif defined(MFC_OpenMP)
3675# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3676
3677# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3678
3679# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3680
3681# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3682!$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)
3683# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3684#endif
3685 do l = is3_weno%beg, is3_weno%end
3686 do k = is2_weno%beg, is2_weno%end
3687 do j = is1_weno%beg, is1_weno%end
3688
3689# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3690#if defined(MFC_OpenACC)
3691# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3692!$acc loop seq
3693# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3694#elif defined(MFC_OpenMP)
3695# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3696
3697# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3698#endif
3699 do i = 1, v_size
3700 ! reconstruct from left side
3701
3702 alpha(:) = 0._wp
3703 omega(:) = 0._wp
3704 delta(:) = 0._wp
3705 beta(:) = weno_eps
3706
3707 dvd(1) = v_rs_ws_x(j + 2, k, l, i) - v_rs_ws_x(j + 1, k, l, i)
3708 dvd(0) = v_rs_ws_x(j + 1, k, l, i) - v_rs_ws_x(j, k, l, i)
3709 dvd(-1) = v_rs_ws_x(j, k, l, i) - v_rs_ws_x(j - 1, k, l, i)
3710 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) - v_rs_ws_x(j - 2, k, l, i)
3711
3712 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 0, &
3713 & 0)*dvd(1) + poly_coef_cbl_x(j, 0, 1)*dvd(0)
3714 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 1, &
3715 & 0)*dvd(0) + poly_coef_cbl_x(j, 1, 1)*dvd(-1)
3716 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 2, &
3717 & 0)*dvd(-1) + poly_coef_cbl_x(j, 2, 1)*dvd(-2)
3718
3719 beta(0) = beta_coef_x(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
3720 & 1)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3721 beta(1) = beta_coef_x(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
3722 & 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 2)*dvd(-1)*dvd(-1) + weno_eps
3723 beta(2) = beta_coef_x(j, 2, 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
3724 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3725
3726 if (wenojs) then
3727 do q = 0, weno_num_stencils
3728 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3729 end do
3730 else if (mapped_weno) then
3731 do q = 0, weno_num_stencils
3732 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
3733 end do
3734 omega = alpha/sum(alpha)
3735 do q = 0, weno_num_stencils
3736 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
3737 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
3738 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
3739 end do
3740 else if (wenoz) then
3741 ! Borges, et al. (2008)
3742
3743 tau = abs(beta(2) - beta(0)) ! Equation 25
3744
3745# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3746#if defined(MFC_OpenACC)
3747# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3748!$acc loop seq
3749# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3750#elif defined(MFC_OpenMP)
3751# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3752
3753# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3754#endif
3755 do q = 0, weno_num_stencils
3756 alpha(q) = d_cbl_x(q, j)*(1._wp + (tau/beta(q)))
3757 ! Equation 28 (note: weno_eps was already added to beta)
3758 end do
3759 else if (teno) then
3760 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3761 tau = abs(beta(2) - beta(0))
3762
3763# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3764#if defined(MFC_OpenACC)
3765# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3766!$acc loop seq
3767# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3768#elif defined(MFC_OpenMP)
3769# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3770
3771# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3772#endif
3773 do q = 0, weno_num_stencils
3774 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
3775 alpha(q) = (alpha(q)**3._wp) &
3776 & **2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
3777 end do
3778 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
3779
3780
3781# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3782#if defined(MFC_OpenACC)
3783# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3784!$acc loop seq
3785# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3786#elif defined(MFC_OpenMP)
3787# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3788
3789# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3790#endif
3791 do q = 0, weno_num_stencils
3792 if (omega(q) < teno_ct) then ! Equation 26
3793 delta(q) = 0._wp
3794 else
3795 delta(q) = 1._wp
3796 end if
3797 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
3798 end do
3799 end if
3800
3801 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3802 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3803 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3804
3805 vl_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3806
3807 ! reconstruct from right side
3808
3809 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 0, &
3810 & 0)*dvd(1) + poly_coef_cbr_x(j, 0, 1)*dvd(0)
3811 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 1, &
3812 & 0)*dvd(0) + poly_coef_cbr_x(j, 1, 1)*dvd(-1)
3813 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 2, &
3814 & 0)*dvd(-1) + poly_coef_cbr_x(j, 2, 1)*dvd(-2)
3815
3816 if (wenojs) then
3817 do q = 0, weno_num_stencils
3818 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3819 end do
3820 else if (mapped_weno) then
3821 do q = 0, weno_num_stencils
3822 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
3823 end do
3824 omega = alpha/sum(alpha)
3825 do q = 0, weno_num_stencils
3826 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
3827 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
3828 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
3829 end do
3830 else if (wenoz) then
3831
3832# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3833#if defined(MFC_OpenACC)
3834# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3835!$acc loop seq
3836# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3837#elif defined(MFC_OpenMP)
3838# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3839
3840# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3841#endif
3842 do q = 0, weno_num_stencils
3843 alpha(q) = d_cbr_x(q, j)*(1._wp + (tau/beta(q)))
3844 end do
3845 else if (teno) then
3846
3847# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3848#if defined(MFC_OpenACC)
3849# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3850!$acc loop seq
3851# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3852#elif defined(MFC_OpenMP)
3853# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3854
3855# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3856#endif
3857 do q = 0, weno_num_stencils
3858 alpha(q) = delta(q)*d_cbr_x(q, j)
3859 end do
3860 end if
3861
3862 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
3863 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
3864 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
3865
3866 vr_rs_vf_x(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
3867 end do
3868 end do
3869 end do
3870 end do
3871
3872# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3873#if defined(MFC_OpenACC)
3874# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3875!$acc end parallel loop
3876# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3877#elif defined(MFC_OpenMP)
3878# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3879
3880# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3881!$omp end target teams loop
3882# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3883#endif
3884
3885 if (mp_weno) then
3886 call s_preserve_monotonicity(v_rs_ws_x, vl_rs_vf_x, vr_rs_vf_x)
3887 end if
3888 end if
3889# 1029 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3890 if (weno_dir == 2) then
3891
3892# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3893
3894# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3895#if defined(MFC_OpenACC)
3896# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3897!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
3898# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3899#elif defined(MFC_OpenMP)
3900# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3901
3902# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3903
3904# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3905
3906# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3907!$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)
3908# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3909#endif
3910 do l = is3_weno%beg, is3_weno%end
3911 do k = is2_weno%beg, is2_weno%end
3912 do j = is1_weno%beg, is1_weno%end
3913
3914# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3915#if defined(MFC_OpenACC)
3916# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3917!$acc loop seq
3918# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3919#elif defined(MFC_OpenMP)
3920# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3921
3922# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3923#endif
3924 do i = 1, v_size
3925 ! reconstruct from left side
3926
3927 alpha(:) = 0._wp
3928 omega(:) = 0._wp
3929 delta(:) = 0._wp
3930 beta(:) = weno_eps
3931
3932 dvd(1) = v_rs_ws_y(j + 2, k, l, i) - v_rs_ws_y(j + 1, k, l, i)
3933 dvd(0) = v_rs_ws_y(j + 1, k, l, i) - v_rs_ws_y(j, k, l, i)
3934 dvd(-1) = v_rs_ws_y(j, k, l, i) - v_rs_ws_y(j - 1, k, l, i)
3935 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) - v_rs_ws_y(j - 2, k, l, i)
3936
3937 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 0, &
3938 & 0)*dvd(1) + poly_coef_cbl_y(j, 0, 1)*dvd(0)
3939 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 1, &
3940 & 0)*dvd(0) + poly_coef_cbl_y(j, 1, 1)*dvd(-1)
3941 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 2, &
3942 & 0)*dvd(-1) + poly_coef_cbl_y(j, 2, 1)*dvd(-2)
3943
3944 beta(0) = beta_coef_y(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_y(j, 0, &
3945 & 1)*dvd(1)*dvd(0) + beta_coef_y(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
3946 beta(1) = beta_coef_y(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_y(j, 1, &
3947 & 1)*dvd(0)*dvd(-1) + beta_coef_y(j, 1, 2)*dvd(-1)*dvd(-1) + weno_eps
3948 beta(2) = beta_coef_y(j, 2, 0)*dvd(-1)*dvd(-1) + beta_coef_y(j, 2, &
3949 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
3950
3951 if (wenojs) then
3952 do q = 0, weno_num_stencils
3953 alpha(q) = d_cbl_y(q, j)/(beta(q)**2._wp)
3954 end do
3955 else if (mapped_weno) then
3956 do q = 0, weno_num_stencils
3957 alpha(q) = d_cbl_y(q, j)/(beta(q)**2._wp)
3958 end do
3959 omega = alpha/sum(alpha)
3960 do q = 0, weno_num_stencils
3961 alpha(q) = (d_cbl_y(q, j)*(1._wp + d_cbl_y(q, &
3962 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
3963 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, j))))
3964 end do
3965 else if (wenoz) then
3966 ! Borges, et al. (2008)
3967
3968 tau = abs(beta(2) - beta(0)) ! Equation 25
3969
3970# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3971#if defined(MFC_OpenACC)
3972# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3973!$acc loop seq
3974# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3975#elif defined(MFC_OpenMP)
3976# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3977
3978# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3979#endif
3980 do q = 0, weno_num_stencils
3981 alpha(q) = d_cbl_y(q, j)*(1._wp + (tau/beta(q)))
3982 ! Equation 28 (note: weno_eps was already added to beta)
3983 end do
3984 else if (teno) then
3985 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
3986 tau = abs(beta(2) - beta(0))
3987
3988# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3989#if defined(MFC_OpenACC)
3990# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3991!$acc loop seq
3992# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3993#elif defined(MFC_OpenMP)
3994# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3995
3996# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
3997#endif
3998 do q = 0, weno_num_stencils
3999 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4000 alpha(q) = (alpha(q)**3._wp) &
4001 & **2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4002 end do
4003 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4004
4005
4006# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4007#if defined(MFC_OpenACC)
4008# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4009!$acc loop seq
4010# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4011#elif defined(MFC_OpenMP)
4012# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4013
4014# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4015#endif
4016 do q = 0, weno_num_stencils
4017 if (omega(q) < teno_ct) then ! Equation 26
4018 delta(q) = 0._wp
4019 else
4020 delta(q) = 1._wp
4021 end if
4022 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
4023 end do
4024 end if
4025
4026 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4027 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4028 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4029
4030 vl_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4031
4032 ! reconstruct from right side
4033
4034 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 0, &
4035 & 0)*dvd(1) + poly_coef_cbr_y(j, 0, 1)*dvd(0)
4036 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 1, &
4037 & 0)*dvd(0) + poly_coef_cbr_y(j, 1, 1)*dvd(-1)
4038 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 2, &
4039 & 0)*dvd(-1) + poly_coef_cbr_y(j, 2, 1)*dvd(-2)
4040
4041 if (wenojs) then
4042 do q = 0, weno_num_stencils
4043 alpha(q) = d_cbr_y(q, j)/(beta(q)**2._wp)
4044 end do
4045 else if (mapped_weno) then
4046 do q = 0, weno_num_stencils
4047 alpha(q) = d_cbr_y(q, j)/(beta(q)**2._wp)
4048 end do
4049 omega = alpha/sum(alpha)
4050 do q = 0, weno_num_stencils
4051 alpha(q) = (d_cbr_y(q, j)*(1._wp + d_cbr_y(q, &
4052 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4053 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, j))))
4054 end do
4055 else if (wenoz) then
4056
4057# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4058#if defined(MFC_OpenACC)
4059# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4060!$acc loop seq
4061# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4062#elif defined(MFC_OpenMP)
4063# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4064
4065# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4066#endif
4067 do q = 0, weno_num_stencils
4068 alpha(q) = d_cbr_y(q, j)*(1._wp + (tau/beta(q)))
4069 end do
4070 else if (teno) then
4071
4072# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4073#if defined(MFC_OpenACC)
4074# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4075!$acc loop seq
4076# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4077#elif defined(MFC_OpenMP)
4078# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4079
4080# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4081#endif
4082 do q = 0, weno_num_stencils
4083 alpha(q) = delta(q)*d_cbr_y(q, j)
4084 end do
4085 end if
4086
4087 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4088 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4089 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4090
4091 vr_rs_vf_y(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4092 end do
4093 end do
4094 end do
4095 end do
4096
4097# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4098#if defined(MFC_OpenACC)
4099# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4100!$acc end parallel loop
4101# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4102#elif defined(MFC_OpenMP)
4103# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4104
4105# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4106!$omp end target teams loop
4107# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4108#endif
4109
4110 if (mp_weno) then
4111 call s_preserve_monotonicity(v_rs_ws_y, vl_rs_vf_y, vr_rs_vf_y)
4112 end if
4113 end if
4114# 1029 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4115 if (weno_dir == 3) then
4116
4117# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4118
4119# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4120#if defined(MFC_OpenACC)
4121# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4122!$acc parallel loop collapse(3) gang vector default(present) private(dvd, poly, beta, alpha, omega, tau, delta, q)
4123# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4124#elif defined(MFC_OpenMP)
4125# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4126
4127# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4128
4129# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4130
4131# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4132!$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)
4133# 1030 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4134#endif
4135 do l = is3_weno%beg, is3_weno%end
4136 do k = is2_weno%beg, is2_weno%end
4137 do j = is1_weno%beg, is1_weno%end
4138
4139# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4140#if defined(MFC_OpenACC)
4141# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4142!$acc loop seq
4143# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4144#elif defined(MFC_OpenMP)
4145# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4146
4147# 1034 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4148#endif
4149 do i = 1, v_size
4150 ! reconstruct from left side
4151
4152 alpha(:) = 0._wp
4153 omega(:) = 0._wp
4154 delta(:) = 0._wp
4155 beta(:) = weno_eps
4156
4157 dvd(1) = v_rs_ws_z(j + 2, k, l, i) - v_rs_ws_z(j + 1, k, l, i)
4158 dvd(0) = v_rs_ws_z(j + 1, k, l, i) - v_rs_ws_z(j, k, l, i)
4159 dvd(-1) = v_rs_ws_z(j, k, l, i) - v_rs_ws_z(j - 1, k, l, i)
4160 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) - v_rs_ws_z(j - 2, k, l, i)
4161
4162 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 0, &
4163 & 0)*dvd(1) + poly_coef_cbl_z(j, 0, 1)*dvd(0)
4164 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 1, &
4165 & 0)*dvd(0) + poly_coef_cbl_z(j, 1, 1)*dvd(-1)
4166 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 2, &
4167 & 0)*dvd(-1) + poly_coef_cbl_z(j, 2, 1)*dvd(-2)
4168
4169 beta(0) = beta_coef_z(j, 0, 0)*dvd(1)*dvd(1) + beta_coef_z(j, 0, &
4170 & 1)*dvd(1)*dvd(0) + beta_coef_z(j, 0, 2)*dvd(0)*dvd(0) + weno_eps
4171 beta(1) = beta_coef_z(j, 1, 0)*dvd(0)*dvd(0) + beta_coef_z(j, 1, &
4172 & 1)*dvd(0)*dvd(-1) + beta_coef_z(j, 1, 2)*dvd(-1)*dvd(-1) + weno_eps
4173 beta(2) = beta_coef_z(j, 2, 0)*dvd(-1)*dvd(-1) + beta_coef_z(j, 2, &
4174 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(j, 2, 2)*dvd(-2)*dvd(-2) + weno_eps
4175
4176 if (wenojs) then
4177 do q = 0, weno_num_stencils
4178 alpha(q) = d_cbl_z(q, j)/(beta(q)**2._wp)
4179 end do
4180 else if (mapped_weno) then
4181 do q = 0, weno_num_stencils
4182 alpha(q) = d_cbl_z(q, j)/(beta(q)**2._wp)
4183 end do
4184 omega = alpha/sum(alpha)
4185 do q = 0, weno_num_stencils
4186 alpha(q) = (d_cbl_z(q, j)*(1._wp + d_cbl_z(q, &
4187 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
4188 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, j))))
4189 end do
4190 else if (wenoz) then
4191 ! Borges, et al. (2008)
4192
4193 tau = abs(beta(2) - beta(0)) ! Equation 25
4194
4195# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4196#if defined(MFC_OpenACC)
4197# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4198!$acc loop seq
4199# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4200#elif defined(MFC_OpenMP)
4201# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4202
4203# 1080 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4204#endif
4205 do q = 0, weno_num_stencils
4206 alpha(q) = d_cbl_z(q, j)*(1._wp + (tau/beta(q)))
4207 ! Equation 28 (note: weno_eps was already added to beta)
4208 end do
4209 else if (teno) then
4210 ! Fu, et al. (2016) Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247
4211 tau = abs(beta(2) - beta(0))
4212
4213# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4214#if defined(MFC_OpenACC)
4215# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4216!$acc loop seq
4217# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4218#elif defined(MFC_OpenMP)
4219# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4220
4221# 1088 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4222#endif
4223 do q = 0, weno_num_stencils
4224 alpha(q) = 1._wp + tau/beta(q) ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6)
4225 alpha(q) = (alpha(q)**3._wp) &
4226 & **2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0)
4227 end do
4228 omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi)
4229
4230
4231# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4232#if defined(MFC_OpenACC)
4233# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4234!$acc loop seq
4235# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4236#elif defined(MFC_OpenMP)
4237# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4238
4239# 1096 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4240#endif
4241 do q = 0, weno_num_stencils
4242 if (omega(q) < teno_ct) then ! Equation 26
4243 delta(q) = 0._wp
4244 else
4245 delta(q) = 1._wp
4246 end if
4247 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
4248 end do
4249 end if
4250
4251 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4252 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4253 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4254
4255 vl_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4256
4257 ! reconstruct from right side
4258
4259 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 0, &
4260 & 0)*dvd(1) + poly_coef_cbr_z(j, 0, 1)*dvd(0)
4261 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 1, &
4262 & 0)*dvd(0) + poly_coef_cbr_z(j, 1, 1)*dvd(-1)
4263 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 2, &
4264 & 0)*dvd(-1) + poly_coef_cbr_z(j, 2, 1)*dvd(-2)
4265
4266 if (wenojs) then
4267 do q = 0, weno_num_stencils
4268 alpha(q) = d_cbr_z(q, j)/(beta(q)**2._wp)
4269 end do
4270 else if (mapped_weno) then
4271 do q = 0, weno_num_stencils
4272 alpha(q) = d_cbr_z(q, j)/(beta(q)**2._wp)
4273 end do
4274 omega = alpha/sum(alpha)
4275 do q = 0, weno_num_stencils
4276 alpha(q) = (d_cbr_z(q, j)*(1._wp + d_cbr_z(q, &
4277 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
4278 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, j))))
4279 end do
4280 else if (wenoz) then
4281
4282# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4283#if defined(MFC_OpenACC)
4284# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4285!$acc loop seq
4286# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4287#elif defined(MFC_OpenMP)
4288# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4289
4290# 1137 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4291#endif
4292 do q = 0, weno_num_stencils
4293 alpha(q) = d_cbr_z(q, j)*(1._wp + (tau/beta(q)))
4294 end do
4295 else if (teno) then
4296
4297# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4298#if defined(MFC_OpenACC)
4299# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4300!$acc loop seq
4301# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4302#elif defined(MFC_OpenMP)
4303# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4304
4305# 1142 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4306#endif
4307 do q = 0, weno_num_stencils
4308 alpha(q) = delta(q)*d_cbr_z(q, j)
4309 end do
4310 end if
4311
4312 omega(0) = alpha(0)/(alpha(0) + alpha(1) + alpha(2))
4313 omega(1) = alpha(1)/(alpha(0) + alpha(1) + alpha(2))
4314 omega(2) = alpha(2)/(alpha(0) + alpha(1) + alpha(2))
4315
4316 vr_rs_vf_z(j, k, l, i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2)
4317 end do
4318 end do
4319 end do
4320 end do
4321
4322# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4323#if defined(MFC_OpenACC)
4324# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4325!$acc end parallel loop
4326# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4327#elif defined(MFC_OpenMP)
4328# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4329
4330# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4331!$omp end target teams loop
4332# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4333#endif
4334
4335 if (mp_weno) then
4336 call s_preserve_monotonicity(v_rs_ws_z, vl_rs_vf_z, vr_rs_vf_z)
4337 end if
4338 end if
4339# 1164 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4340# 1165 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4341 end if
4342 if (weno_order == 7 .or. dummy) then
4343# 1168 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4344# 1169 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4345 if (weno_dir == 1) then
4346
4347# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4348
4349# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4350#if defined(MFC_OpenACC)
4351# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4352!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4353# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4354#elif defined(MFC_OpenMP)
4355# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4356
4357# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4358
4359# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4360
4361# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4362!$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)
4363# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4364#endif
4365 do l = is3_weno%beg, is3_weno%end
4366 do k = is2_weno%beg, is2_weno%end
4367 do j = is1_weno%beg, is1_weno%end
4368
4369# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4370#if defined(MFC_OpenACC)
4371# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4372!$acc loop seq
4373# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4374#elif defined(MFC_OpenMP)
4375# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4376
4377# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4378#endif
4379 do i = 1, v_size
4380 alpha(:) = 0._wp
4381 omega(:) = 0._wp
4382 delta(:) = 0._wp
4383 beta(:) = weno_eps
4384
4385 if (teno) v = v_rs_ws_x(j - 3:j + 3,k, l, &
4386 & i) ! temporary field value array for clarity
4387
4388 if (.not. teno) then
4389 dvd(2) = v_rs_ws_x(j + 3, k, l, i) - v_rs_ws_x(j + 2, k, l, i)
4390 dvd(1) = v_rs_ws_x(j + 2, k, l, i) - v_rs_ws_x(j + 1, k, l, i)
4391 dvd(0) = v_rs_ws_x(j + 1, k, l, i) - v_rs_ws_x(j, k, l, i)
4392 dvd(-1) = v_rs_ws_x(j, k, l, i) - v_rs_ws_x(j - 1, k, l, i)
4393 dvd(-2) = v_rs_ws_x(j - 1, k, l, i) - v_rs_ws_x(j - 2, k, l, i)
4394 dvd(-3) = v_rs_ws_x(j - 2, k, l, i) - v_rs_ws_x(j - 3, k, l, i)
4395
4396 poly(3) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 0, &
4397 & 0)*dvd(2) + poly_coef_cbl_x(j, 0, 1)*dvd(1) + poly_coef_cbl_x(j, &
4398 & 0, 2)*dvd(0)
4399 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 1, &
4400 & 0)*dvd(1) + poly_coef_cbl_x(j, 1, 1)*dvd(0) + poly_coef_cbl_x(j, &
4401 & 1, 2)*dvd(-1)
4402 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 2, &
4403 & 0)*dvd(0) + poly_coef_cbl_x(j, 2, &
4404 & 1)*dvd(-1) + poly_coef_cbl_x(j, 2, 2)*dvd(-2)
4405 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbl_x(j, 3, &
4406 & 0)*dvd(-1) + poly_coef_cbl_x(j, 3, &
4407 & 1)*dvd(-2) + poly_coef_cbl_x(j, 3, 2)*dvd(-3)
4408 else
4409# 1206 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4410 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4411 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4412 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4413 ! to keep the stencil order to reuse the beta coefficients
4414 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4415 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4416 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4417 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4418 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4419# 1216 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4420 end if
4421
4422 if (.not. teno) then
4423 beta(3) = beta_coef_x(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_x(j, 0, &
4424 & 1)*dvd(2)*dvd(1) + beta_coef_x(j, 0, &
4425 & 2)*dvd(2)*dvd(0) + beta_coef_x(j, 0, &
4426 & 3)*dvd(1)*dvd(1) + beta_coef_x(j, 0, &
4427 & 4)*dvd(1)*dvd(0) + beta_coef_x(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4428
4429 beta(2) = beta_coef_x(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_x(j, 1, &
4430 & 1)*dvd(1)*dvd(0) + beta_coef_x(j, 1, &
4431 & 2)*dvd(1)*dvd(-1) + beta_coef_x(j, 1, &
4432 & 3)*dvd(0)*dvd(0) + beta_coef_x(j, 1, &
4433 & 4)*dvd(0)*dvd(-1) + beta_coef_x(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4434
4435 beta(1) = beta_coef_x(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_x(j, 2, &
4436 & 1)*dvd(0)*dvd(-1) + beta_coef_x(j, 2, &
4437 & 2)*dvd(0)*dvd(-2) + beta_coef_x(j, 2, &
4438 & 3)*dvd(-1)*dvd(-1) + beta_coef_x(j, 2, &
4439 & 4)*dvd(-1)*dvd(-2) + beta_coef_x(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4440
4441 beta(0) = beta_coef_x(j, 3, 0)*dvd(-1)*dvd(-1) + beta_coef_x(j, 3, &
4442 & 1)*dvd(-1)*dvd(-2) + beta_coef_x(j, 3, &
4443 & 2)*dvd(-1)*dvd(-3) + beta_coef_x(j, 3, &
4444 & 3)*dvd(-2)*dvd(-2) + beta_coef_x(j, 3, &
4445 & 4)*dvd(-2)*dvd(-3) + beta_coef_x(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4446 else ! TENO
4447# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4448 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4449 ! & Tang, 2019) Section 3.2
4450 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4451 & **2._wp)/4._wp + weno_eps
4452 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4453 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4454 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4455 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4456
4457 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4458 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4459 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4460
4461 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4462 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4463 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4464# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4465 end if
4466
4467 if (wenojs) then
4468 do q = 0, weno_num_stencils
4469 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4470 end do
4471 else if (mapped_weno) then
4472 do q = 0, weno_num_stencils
4473 alpha(q) = d_cbl_x(q, j)/(beta(q)**2._wp)
4474 end do
4475 omega = alpha/sum(alpha)
4476 do q = 0, weno_num_stencils
4477 alpha(q) = (d_cbl_x(q, j)*(1._wp + d_cbl_x(q, &
4478 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_x(q, &
4479 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_x(q, j))))
4480 end do
4481 else if (wenoz) then
4482 ! Castro, et al. (2010) Don & Borges (2013) also helps
4483 tau = abs(beta(3) - beta(0)) ! Equation 50
4484
4485# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4486#if defined(MFC_OpenACC)
4487# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4488!$acc loop seq
4489# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4490#elif defined(MFC_OpenMP)
4491# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4492
4493# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4494#endif
4495 do q = 0, weno_num_stencils
4496 alpha(q) = d_cbl_x(q, &
4497 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4498 end do
4499 else if (teno) then
4500# 1287 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4501 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4502 alpha = 1._wp + tau/beta
4503 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4504 omega = alpha/sum(alpha)
4505
4506
4507# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4508#if defined(MFC_OpenACC)
4509# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4510!$acc loop seq
4511# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4512#elif defined(MFC_OpenMP)
4513# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4514
4515# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4516#endif
4517 do q = 0, weno_num_stencils
4518 if (omega(q) < teno_ct) then ! Equation 26
4519 delta(q) = 0._wp
4520 else
4521 delta(q) = 1._wp
4522 end if
4523 alpha(q) = delta(q)*d_cbl_x(q, j) ! Equation 27
4524 end do
4525# 1302 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4526 end if
4527
4528 omega = alpha/sum(alpha)
4529
4530 vl_rs_vf_x(j, k, l, &
4531 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4532 & *poly(3)
4533
4534 if (teno) then
4535# 1312 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4536 vl_rs_vf_x(j, k, l, i) = vl_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4537# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4538 end if
4539
4540 if (.not. teno) then
4541 poly(3) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 0, &
4542 & 0)*dvd(2) + poly_coef_cbr_x(j, 0, 1)*dvd(1) + poly_coef_cbr_x(j, &
4543 & 0, 2)*dvd(0)
4544 poly(2) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 1, &
4545 & 0)*dvd(1) + poly_coef_cbr_x(j, 1, 1)*dvd(0) + poly_coef_cbr_x(j, &
4546 & 1, 2)*dvd(-1)
4547 poly(1) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 2, &
4548 & 0)*dvd(0) + poly_coef_cbr_x(j, 2, &
4549 & 1)*dvd(-1) + poly_coef_cbr_x(j, 2, 2)*dvd(-2)
4550 poly(0) = v_rs_ws_x(j, k, l, i) + poly_coef_cbr_x(j, 3, &
4551 & 0)*dvd(-1) + poly_coef_cbr_x(j, 3, &
4552 & 1)*dvd(-2) + poly_coef_cbr_x(j, 3, 2)*dvd(-3)
4553 else
4554# 1331 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4555 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4556 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4557 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4558 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4559 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4560# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4561 end if
4562
4563 if (wenojs) then
4564 do q = 0, weno_num_stencils
4565 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4566 end do
4567 else if (mapped_weno) then
4568 do q = 0, weno_num_stencils
4569 alpha(q) = d_cbr_x(q, j)/(beta(q)**2._wp)
4570 end do
4571 omega = alpha/sum(alpha)
4572 do q = 0, weno_num_stencils
4573 alpha(q) = (d_cbr_x(q, j)*(1._wp + d_cbr_x(q, &
4574 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_x(q, &
4575 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_x(q, j))))
4576 end do
4577 else if (wenoz) then
4578
4579# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4580#if defined(MFC_OpenACC)
4581# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4582!$acc loop seq
4583# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4584#elif defined(MFC_OpenMP)
4585# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4586
4587# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4588#endif
4589 do q = 0, weno_num_stencils
4590 alpha(q) = d_cbr_x(q, &
4591 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4592 end do
4593 else if (teno) then
4594
4595# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4596#if defined(MFC_OpenACC)
4597# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4598!$acc loop seq
4599# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4600#elif defined(MFC_OpenMP)
4601# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4602
4603# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4604#endif
4605 do q = 0, weno_num_stencils
4606 alpha(q) = delta(q)*d_cbr_x(q, j)
4607 end do
4608 end if
4609
4610 omega = alpha/sum(alpha)
4611
4612 vr_rs_vf_x(j, k, l, &
4613 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4614 & *poly(3)
4615
4616 if (teno) then
4617# 1374 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4618 vr_rs_vf_x(j, k, l, i) = vr_rs_vf_x(j, k, l, i) + omega(4)*poly(4)
4619# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4620 end if
4621 end do
4622 end do
4623 end do
4624 end do
4625
4626# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4627#if defined(MFC_OpenACC)
4628# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4629!$acc end parallel loop
4630# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4631#elif defined(MFC_OpenMP)
4632# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4633
4634# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4635!$omp end target teams loop
4636# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4637#endif
4638 end if
4639# 1169 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4640 if (weno_dir == 2) then
4641
4642# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4643
4644# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4645#if defined(MFC_OpenACC)
4646# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4647!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4648# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4649#elif defined(MFC_OpenMP)
4650# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4651
4652# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4653
4654# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4655
4656# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4657!$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)
4658# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4659#endif
4660 do l = is3_weno%beg, is3_weno%end
4661 do k = is2_weno%beg, is2_weno%end
4662 do j = is1_weno%beg, is1_weno%end
4663
4664# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4665#if defined(MFC_OpenACC)
4666# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4667!$acc loop seq
4668# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4669#elif defined(MFC_OpenMP)
4670# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4671
4672# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4673#endif
4674 do i = 1, v_size
4675 alpha(:) = 0._wp
4676 omega(:) = 0._wp
4677 delta(:) = 0._wp
4678 beta(:) = weno_eps
4679
4680 if (teno) v = v_rs_ws_y(j - 3:j + 3,k, l, &
4681 & i) ! temporary field value array for clarity
4682
4683 if (.not. teno) then
4684 dvd(2) = v_rs_ws_y(j + 3, k, l, i) - v_rs_ws_y(j + 2, k, l, i)
4685 dvd(1) = v_rs_ws_y(j + 2, k, l, i) - v_rs_ws_y(j + 1, k, l, i)
4686 dvd(0) = v_rs_ws_y(j + 1, k, l, i) - v_rs_ws_y(j, k, l, i)
4687 dvd(-1) = v_rs_ws_y(j, k, l, i) - v_rs_ws_y(j - 1, k, l, i)
4688 dvd(-2) = v_rs_ws_y(j - 1, k, l, i) - v_rs_ws_y(j - 2, k, l, i)
4689 dvd(-3) = v_rs_ws_y(j - 2, k, l, i) - v_rs_ws_y(j - 3, k, l, i)
4690
4691 poly(3) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 0, &
4692 & 0)*dvd(2) + poly_coef_cbl_y(j, 0, 1)*dvd(1) + poly_coef_cbl_y(j, &
4693 & 0, 2)*dvd(0)
4694 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 1, &
4695 & 0)*dvd(1) + poly_coef_cbl_y(j, 1, 1)*dvd(0) + poly_coef_cbl_y(j, &
4696 & 1, 2)*dvd(-1)
4697 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 2, &
4698 & 0)*dvd(0) + poly_coef_cbl_y(j, 2, &
4699 & 1)*dvd(-1) + poly_coef_cbl_y(j, 2, 2)*dvd(-2)
4700 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbl_y(j, 3, &
4701 & 0)*dvd(-1) + poly_coef_cbl_y(j, 3, &
4702 & 1)*dvd(-2) + poly_coef_cbl_y(j, 3, 2)*dvd(-3)
4703 else
4704# 1206 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4705 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
4706 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
4707 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
4708 ! to keep the stencil order to reuse the beta coefficients
4709 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
4710 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
4711 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
4712 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
4713 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
4714# 1216 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4715 end if
4716
4717 if (.not. teno) then
4718 beta(3) = beta_coef_y(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_y(j, 0, &
4719 & 1)*dvd(2)*dvd(1) + beta_coef_y(j, 0, &
4720 & 2)*dvd(2)*dvd(0) + beta_coef_y(j, 0, &
4721 & 3)*dvd(1)*dvd(1) + beta_coef_y(j, 0, &
4722 & 4)*dvd(1)*dvd(0) + beta_coef_y(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
4723
4724 beta(2) = beta_coef_y(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_y(j, 1, &
4725 & 1)*dvd(1)*dvd(0) + beta_coef_y(j, 1, &
4726 & 2)*dvd(1)*dvd(-1) + beta_coef_y(j, 1, &
4727 & 3)*dvd(0)*dvd(0) + beta_coef_y(j, 1, &
4728 & 4)*dvd(0)*dvd(-1) + beta_coef_y(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
4729
4730 beta(1) = beta_coef_y(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_y(j, 2, &
4731 & 1)*dvd(0)*dvd(-1) + beta_coef_y(j, 2, &
4732 & 2)*dvd(0)*dvd(-2) + beta_coef_y(j, 2, &
4733 & 3)*dvd(-1)*dvd(-1) + beta_coef_y(j, 2, &
4734 & 4)*dvd(-1)*dvd(-2) + beta_coef_y(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
4735
4736 beta(0) = beta_coef_y(j, 3, 0)*dvd(-1)*dvd(-1) + beta_coef_y(j, 3, &
4737 & 1)*dvd(-1)*dvd(-2) + beta_coef_y(j, 3, &
4738 & 2)*dvd(-1)*dvd(-3) + beta_coef_y(j, 3, &
4739 & 3)*dvd(-2)*dvd(-2) + beta_coef_y(j, 3, &
4740 & 4)*dvd(-2)*dvd(-3) + beta_coef_y(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
4741 else ! TENO
4742# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4743 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
4744 ! & Tang, 2019) Section 3.2
4745 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
4746 & **2._wp)/4._wp + weno_eps
4747 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
4748 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
4749 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
4750 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
4751
4752 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
4753 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
4754 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
4755
4756 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
4757 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
4758 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
4759# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4760 end if
4761
4762 if (wenojs) then
4763 do q = 0, weno_num_stencils
4764 alpha(q) = d_cbl_y(q, j)/(beta(q)**2._wp)
4765 end do
4766 else if (mapped_weno) then
4767 do q = 0, weno_num_stencils
4768 alpha(q) = d_cbl_y(q, j)/(beta(q)**2._wp)
4769 end do
4770 omega = alpha/sum(alpha)
4771 do q = 0, weno_num_stencils
4772 alpha(q) = (d_cbl_y(q, j)*(1._wp + d_cbl_y(q, &
4773 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_y(q, &
4774 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_y(q, j))))
4775 end do
4776 else if (wenoz) then
4777 ! Castro, et al. (2010) Don & Borges (2013) also helps
4778 tau = abs(beta(3) - beta(0)) ! Equation 50
4779
4780# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4781#if defined(MFC_OpenACC)
4782# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4783!$acc loop seq
4784# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4785#elif defined(MFC_OpenMP)
4786# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4787
4788# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4789#endif
4790 do q = 0, weno_num_stencils
4791 alpha(q) = d_cbl_y(q, &
4792 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4793 end do
4794 else if (teno) then
4795# 1287 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4796 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
4797 alpha = 1._wp + tau/beta
4798 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
4799 omega = alpha/sum(alpha)
4800
4801
4802# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4803#if defined(MFC_OpenACC)
4804# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4805!$acc loop seq
4806# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4807#elif defined(MFC_OpenMP)
4808# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4809
4810# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4811#endif
4812 do q = 0, weno_num_stencils
4813 if (omega(q) < teno_ct) then ! Equation 26
4814 delta(q) = 0._wp
4815 else
4816 delta(q) = 1._wp
4817 end if
4818 alpha(q) = delta(q)*d_cbl_y(q, j) ! Equation 27
4819 end do
4820# 1302 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4821 end if
4822
4823 omega = alpha/sum(alpha)
4824
4825 vl_rs_vf_y(j, k, l, &
4826 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4827 & *poly(3)
4828
4829 if (teno) then
4830# 1312 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4831 vl_rs_vf_y(j, k, l, i) = vl_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4832# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4833 end if
4834
4835 if (.not. teno) then
4836 poly(3) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 0, &
4837 & 0)*dvd(2) + poly_coef_cbr_y(j, 0, 1)*dvd(1) + poly_coef_cbr_y(j, &
4838 & 0, 2)*dvd(0)
4839 poly(2) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 1, &
4840 & 0)*dvd(1) + poly_coef_cbr_y(j, 1, 1)*dvd(0) + poly_coef_cbr_y(j, &
4841 & 1, 2)*dvd(-1)
4842 poly(1) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 2, &
4843 & 0)*dvd(0) + poly_coef_cbr_y(j, 2, &
4844 & 1)*dvd(-1) + poly_coef_cbr_y(j, 2, 2)*dvd(-2)
4845 poly(0) = v_rs_ws_y(j, k, l, i) + poly_coef_cbr_y(j, 3, &
4846 & 0)*dvd(-1) + poly_coef_cbr_y(j, 3, &
4847 & 1)*dvd(-2) + poly_coef_cbr_y(j, 3, 2)*dvd(-3)
4848 else
4849# 1331 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4850 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
4851 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
4852 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
4853 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
4854 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
4855# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4856 end if
4857
4858 if (wenojs) then
4859 do q = 0, weno_num_stencils
4860 alpha(q) = d_cbr_y(q, j)/(beta(q)**2._wp)
4861 end do
4862 else if (mapped_weno) then
4863 do q = 0, weno_num_stencils
4864 alpha(q) = d_cbr_y(q, j)/(beta(q)**2._wp)
4865 end do
4866 omega = alpha/sum(alpha)
4867 do q = 0, weno_num_stencils
4868 alpha(q) = (d_cbr_y(q, j)*(1._wp + d_cbr_y(q, &
4869 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_y(q, &
4870 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_y(q, j))))
4871 end do
4872 else if (wenoz) then
4873
4874# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4875#if defined(MFC_OpenACC)
4876# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4877!$acc loop seq
4878# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4879#elif defined(MFC_OpenMP)
4880# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4881
4882# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4883#endif
4884 do q = 0, weno_num_stencils
4885 alpha(q) = d_cbr_y(q, &
4886 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
4887 end do
4888 else if (teno) then
4889
4890# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4891#if defined(MFC_OpenACC)
4892# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4893!$acc loop seq
4894# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4895#elif defined(MFC_OpenMP)
4896# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4897
4898# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4899#endif
4900 do q = 0, weno_num_stencils
4901 alpha(q) = delta(q)*d_cbr_y(q, j)
4902 end do
4903 end if
4904
4905 omega = alpha/sum(alpha)
4906
4907 vr_rs_vf_y(j, k, l, &
4908 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
4909 & *poly(3)
4910
4911 if (teno) then
4912# 1374 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4913 vr_rs_vf_y(j, k, l, i) = vr_rs_vf_y(j, k, l, i) + omega(4)*poly(4)
4914# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4915 end if
4916 end do
4917 end do
4918 end do
4919 end do
4920
4921# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4922#if defined(MFC_OpenACC)
4923# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4924!$acc end parallel loop
4925# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4926#elif defined(MFC_OpenMP)
4927# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4928
4929# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4930!$omp end target teams loop
4931# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4932#endif
4933 end if
4934# 1169 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4935 if (weno_dir == 3) then
4936
4937# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4938
4939# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4940#if defined(MFC_OpenACC)
4941# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4942!$acc parallel loop collapse(3) gang vector default(present) private(poly, beta, alpha, omega, tau, delta, dvd, v, q)
4943# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4944#elif defined(MFC_OpenMP)
4945# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4946
4947# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4948
4949# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4950
4951# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4952!$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)
4953# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4954#endif
4955 do l = is3_weno%beg, is3_weno%end
4956 do k = is2_weno%beg, is2_weno%end
4957 do j = is1_weno%beg, is1_weno%end
4958
4959# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4960#if defined(MFC_OpenACC)
4961# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4962!$acc loop seq
4963# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4964#elif defined(MFC_OpenMP)
4965# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4966
4967# 1174 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
4968#endif
4969 do i = 1, v_size
4970 alpha(:) = 0._wp
4971 omega(:) = 0._wp
4972 delta(:) = 0._wp
4973 beta(:) = weno_eps
4974
4975 if (teno) v = v_rs_ws_z(j - 3:j + 3,k, l, &
4976 & i) ! temporary field value array for clarity
4977
4978 if (.not. teno) then
4979 dvd(2) = v_rs_ws_z(j + 3, k, l, i) - v_rs_ws_z(j + 2, k, l, i)
4980 dvd(1) = v_rs_ws_z(j + 2, k, l, i) - v_rs_ws_z(j + 1, k, l, i)
4981 dvd(0) = v_rs_ws_z(j + 1, k, l, i) - v_rs_ws_z(j, k, l, i)
4982 dvd(-1) = v_rs_ws_z(j, k, l, i) - v_rs_ws_z(j - 1, k, l, i)
4983 dvd(-2) = v_rs_ws_z(j - 1, k, l, i) - v_rs_ws_z(j - 2, k, l, i)
4984 dvd(-3) = v_rs_ws_z(j - 2, k, l, i) - v_rs_ws_z(j - 3, k, l, i)
4985
4986 poly(3) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 0, &
4987 & 0)*dvd(2) + poly_coef_cbl_z(j, 0, 1)*dvd(1) + poly_coef_cbl_z(j, &
4988 & 0, 2)*dvd(0)
4989 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 1, &
4990 & 0)*dvd(1) + poly_coef_cbl_z(j, 1, 1)*dvd(0) + poly_coef_cbl_z(j, &
4991 & 1, 2)*dvd(-1)
4992 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 2, &
4993 & 0)*dvd(0) + poly_coef_cbl_z(j, 2, &
4994 & 1)*dvd(-1) + poly_coef_cbl_z(j, 2, 2)*dvd(-2)
4995 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbl_z(j, 3, &
4996 & 0)*dvd(-1) + poly_coef_cbl_z(j, 3, &
4997 & 1)*dvd(-2) + poly_coef_cbl_z(j, 3, 2)*dvd(-3)
4998 else
4999# 1206 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5000 ! (Fu, et al., 2016) Table 1 Note: Unlike TENO5, TENO7 stencils differ from WENO7
5001 ! stencils See Figure 2 (right) for right-sided flux (at i+1/2) Here we need the
5002 ! left-sided flux, so we flip the weights with respect to the x=i point But we need
5003 ! to keep the stencil order to reuse the beta coefficients
5004 poly(0) = (2._wp*v(-1) + 5._wp*v(0) - 1._wp*v(1))/6._wp
5005 poly(1) = (11._wp*v(0) - 7._wp*v(1) + 2._wp*v(2))/6._wp
5006 poly(2) = (-1._wp*v(-2) + 5._wp*v(-1) + 2._wp*v(0))/6._wp
5007 poly(3) = (25._wp*v(0) - 23._wp*v(1) + 13._wp*v(2) - 3._wp*v(3))/12._wp
5008 poly(4) = (1._wp*v(-3) - 5._wp*v(-2) + 13._wp*v(-1) + 3._wp*v(0))/12._wp
5009# 1216 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5010 end if
5011
5012 if (.not. teno) then
5013 beta(3) = beta_coef_z(j, 0, 0)*dvd(2)*dvd(2) + beta_coef_z(j, 0, &
5014 & 1)*dvd(2)*dvd(1) + beta_coef_z(j, 0, &
5015 & 2)*dvd(2)*dvd(0) + beta_coef_z(j, 0, &
5016 & 3)*dvd(1)*dvd(1) + beta_coef_z(j, 0, &
5017 & 4)*dvd(1)*dvd(0) + beta_coef_z(j, 0, 5)*dvd(0)*dvd(0) + weno_eps
5018
5019 beta(2) = beta_coef_z(j, 1, 0)*dvd(1)*dvd(1) + beta_coef_z(j, 1, &
5020 & 1)*dvd(1)*dvd(0) + beta_coef_z(j, 1, &
5021 & 2)*dvd(1)*dvd(-1) + beta_coef_z(j, 1, &
5022 & 3)*dvd(0)*dvd(0) + beta_coef_z(j, 1, &
5023 & 4)*dvd(0)*dvd(-1) + beta_coef_z(j, 1, 5)*dvd(-1)*dvd(-1) + weno_eps
5024
5025 beta(1) = beta_coef_z(j, 2, 0)*dvd(0)*dvd(0) + beta_coef_z(j, 2, &
5026 & 1)*dvd(0)*dvd(-1) + beta_coef_z(j, 2, &
5027 & 2)*dvd(0)*dvd(-2) + beta_coef_z(j, 2, &
5028 & 3)*dvd(-1)*dvd(-1) + beta_coef_z(j, 2, &
5029 & 4)*dvd(-1)*dvd(-2) + beta_coef_z(j, 2, 5)*dvd(-2)*dvd(-2) + weno_eps
5030
5031 beta(0) = beta_coef_z(j, 3, 0)*dvd(-1)*dvd(-1) + beta_coef_z(j, 3, &
5032 & 1)*dvd(-1)*dvd(-2) + beta_coef_z(j, 3, &
5033 & 2)*dvd(-1)*dvd(-3) + beta_coef_z(j, 3, &
5034 & 3)*dvd(-2)*dvd(-2) + beta_coef_z(j, 3, &
5035 & 4)*dvd(-2)*dvd(-3) + beta_coef_z(j, 3, 5)*dvd(-3)*dvd(-3) + weno_eps
5036 else ! TENO
5037# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5038 ! High-Order Low-Dissipation Targeted ENO Schemes for Ideal Magnetohydrodynamics (Fu
5039 ! & Tang, 2019) Section 3.2
5040 beta(0) = 13._wp/12._wp*(v(-1) - 2._wp*v(0) + v(1))**2._wp + ((v(-1) - v(1)) &
5041 & **2._wp)/4._wp + weno_eps
5042 beta(1) = 13._wp/12._wp*(v(0) - 2._wp*v(1) + v(2))**2._wp + ((3._wp*v(0) &
5043 & - 4._wp*v(1) + v(2))**2._wp)/4._wp + weno_eps
5044 beta(2) = 13._wp/12._wp*(v(-2) - 2._wp*v(-1) + v(0))**2._wp + ((v(-2) &
5045 & - 4._wp*v(-1) + 3._wp*v(0))**2._wp)/4._wp + weno_eps
5046
5047 beta(3) = (v(0)*(2107._wp*v(0) - 9402._wp*v(1) + 7042._wp*v(2) - 1854._wp*v(3)) &
5048 & + v(1)*(11003._wp*v(1) - 17246._wp*v(2) + 4642._wp*v(3)) + v(2) &
5049 & *(7043._wp*v(2) - 3882._wp*v(3)) + v(3)*(547._wp*v(3)))/240._wp + weno_eps
5050
5051 beta(4) = (v(-3)*(547._wp*v(-3) - 3882._wp*v(-2) + 4642._wp*v(-1) - 1854._wp*v(0)) &
5052 & + v(-2)*(7043._wp*v(-2) - 17246._wp*v(-1) + 7042._wp*v(0)) + v(-1) &
5053 & *(11003._wp*v(-1) - 9402._wp*v(0)) + v(0)*(2107._wp*v(0)))/240._wp + weno_eps
5054# 1261 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5055 end if
5056
5057 if (wenojs) then
5058 do q = 0, weno_num_stencils
5059 alpha(q) = d_cbl_z(q, j)/(beta(q)**2._wp)
5060 end do
5061 else if (mapped_weno) then
5062 do q = 0, weno_num_stencils
5063 alpha(q) = d_cbl_z(q, j)/(beta(q)**2._wp)
5064 end do
5065 omega = alpha/sum(alpha)
5066 do q = 0, weno_num_stencils
5067 alpha(q) = (d_cbl_z(q, j)*(1._wp + d_cbl_z(q, &
5068 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbl_z(q, &
5069 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbl_z(q, j))))
5070 end do
5071 else if (wenoz) then
5072 ! Castro, et al. (2010) Don & Borges (2013) also helps
5073 tau = abs(beta(3) - beta(0)) ! Equation 50
5074
5075# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5076#if defined(MFC_OpenACC)
5077# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5078!$acc loop seq
5079# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5080#elif defined(MFC_OpenMP)
5081# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5082
5083# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5084#endif
5085 do q = 0, weno_num_stencils
5086 alpha(q) = d_cbl_z(q, &
5087 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
5088 end do
5089 else if (teno) then
5090# 1287 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5091 tau = abs(beta(4) - beta(3)) ! Note the reordering of stencils
5092 alpha = 1._wp + tau/beta
5093 alpha = (alpha**3._wp)**2._wp ! some CPU compilers cannot optimize x**6.0
5094 omega = alpha/sum(alpha)
5095
5096
5097# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5098#if defined(MFC_OpenACC)
5099# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5100!$acc loop seq
5101# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5102#elif defined(MFC_OpenMP)
5103# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5104
5105# 1292 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5106#endif
5107 do q = 0, weno_num_stencils
5108 if (omega(q) < teno_ct) then ! Equation 26
5109 delta(q) = 0._wp
5110 else
5111 delta(q) = 1._wp
5112 end if
5113 alpha(q) = delta(q)*d_cbl_z(q, j) ! Equation 27
5114 end do
5115# 1302 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5116 end if
5117
5118 omega = alpha/sum(alpha)
5119
5120 vl_rs_vf_z(j, k, l, &
5121 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
5122 & *poly(3)
5123
5124 if (teno) then
5125# 1312 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5126 vl_rs_vf_z(j, k, l, i) = vl_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
5127# 1314 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5128 end if
5129
5130 if (.not. teno) then
5131 poly(3) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 0, &
5132 & 0)*dvd(2) + poly_coef_cbr_z(j, 0, 1)*dvd(1) + poly_coef_cbr_z(j, &
5133 & 0, 2)*dvd(0)
5134 poly(2) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 1, &
5135 & 0)*dvd(1) + poly_coef_cbr_z(j, 1, 1)*dvd(0) + poly_coef_cbr_z(j, &
5136 & 1, 2)*dvd(-1)
5137 poly(1) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 2, &
5138 & 0)*dvd(0) + poly_coef_cbr_z(j, 2, &
5139 & 1)*dvd(-1) + poly_coef_cbr_z(j, 2, 2)*dvd(-2)
5140 poly(0) = v_rs_ws_z(j, k, l, i) + poly_coef_cbr_z(j, 3, &
5141 & 0)*dvd(-1) + poly_coef_cbr_z(j, 3, &
5142 & 1)*dvd(-2) + poly_coef_cbr_z(j, 3, 2)*dvd(-3)
5143 else
5144# 1331 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5145 poly(0) = (-1._wp*v(-1) + 5._wp*v(0) + 2._wp*v(1))/6._wp
5146 poly(1) = (2._wp*v(0) + 5._wp*v(1) - 1._wp*v(2))/6._wp
5147 poly(2) = (2._wp*v(-2) - 7._wp*v(-1) + 11._wp*v(0))/6._wp
5148 poly(3) = (3._wp*v(0) + 13._wp*v(1) - 5._wp*v(2) + 1._wp*v(3))/12._wp
5149 poly(4) = (-3._wp*v(-3) + 13._wp*v(-2) - 23._wp*v(-1) + 25._wp*v(0))/12._wp
5150# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5151 end if
5152
5153 if (wenojs) then
5154 do q = 0, weno_num_stencils
5155 alpha(q) = d_cbr_z(q, j)/(beta(q)**2._wp)
5156 end do
5157 else if (mapped_weno) then
5158 do q = 0, weno_num_stencils
5159 alpha(q) = d_cbr_z(q, j)/(beta(q)**2._wp)
5160 end do
5161 omega = alpha/sum(alpha)
5162 do q = 0, weno_num_stencils
5163 alpha(q) = (d_cbr_z(q, j)*(1._wp + d_cbr_z(q, &
5164 & j) - 3._wp*omega(q)) + omega(q)**2._wp)*(omega(q)/(d_cbr_z(q, &
5165 & j)**2._wp + omega(q)*(1._wp - 2._wp*d_cbr_z(q, j))))
5166 end do
5167 else if (wenoz) then
5168
5169# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5170#if defined(MFC_OpenACC)
5171# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5172!$acc loop seq
5173# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5174#elif defined(MFC_OpenMP)
5175# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5176
5177# 1354 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5178#endif
5179 do q = 0, weno_num_stencils
5180 alpha(q) = d_cbr_z(q, &
5181 & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability
5182 end do
5183 else if (teno) then
5184
5185# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5186#if defined(MFC_OpenACC)
5187# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5188!$acc loop seq
5189# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5190#elif defined(MFC_OpenMP)
5191# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5192
5193# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5194#endif
5195 do q = 0, weno_num_stencils
5196 alpha(q) = delta(q)*d_cbr_z(q, j)
5197 end do
5198 end if
5199
5200 omega = alpha/sum(alpha)
5201
5202 vr_rs_vf_z(j, k, l, &
5203 & i) = omega(0)*poly(0) + omega(1)*poly(1) + omega(2)*poly(2) + omega(3) &
5204 & *poly(3)
5205
5206 if (teno) then
5207# 1374 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5208 vr_rs_vf_z(j, k, l, i) = vr_rs_vf_z(j, k, l, i) + omega(4)*poly(4)
5209# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5210 end if
5211 end do
5212 end do
5213 end do
5214 end do
5215
5216# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5217#if defined(MFC_OpenACC)
5218# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5219!$acc end parallel loop
5220# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5221#elif defined(MFC_OpenMP)
5222# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5223
5224# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5225!$omp end target teams loop
5226# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5227#endif
5228 end if
5229# 1384 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5230# 1385 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5231 end if
5232
5233 if (int_comp) then
5234 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, &
5235 & is1_weno_d, is2_weno_d, is3_weno_d)
5236 end if
5237
5238 end subroutine s_weno
5239
5240 !> Set up the WENO reconstruction for a given direction
5241 subroutine s_initialize_weno(v_vf, weno_dir)
5242
5243 type(scalar_field), dimension(:), intent(in) :: v_vf
5244 integer, intent(in) :: weno_dir
5245 integer :: j, k, l, q
5246
5247 ! Determine WENO-reconstructed variables and map coordinate directions
5248
5249 v_size = ubound(v_vf, 1)
5250
5251# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5252#if defined(MFC_OpenACC)
5253# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5254!$acc update device(v_size)
5255# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5256#elif defined(MFC_OpenMP)
5257# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5258!$omp target update to(v_size)
5259# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5260#endif
5261
5262 if (weno_dir == 1) then
5263
5264# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5265
5266# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5267#if defined(MFC_OpenACC)
5268# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5269!$acc parallel loop collapse(4) gang vector default(present)
5270# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5271#elif defined(MFC_OpenMP)
5272# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5273
5274# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5275
5276# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5277
5278# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5279!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5280# 1407 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5281#endif
5282 do j = 1, v_size
5283 do q = is3_weno%beg, is3_weno%end
5284 do l = is2_weno%beg, is2_weno%end
5285 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
5286 v_rs_ws_x(k, l, q, j) = v_vf(j)%sf(k, l, q)
5287 end do
5288 end do
5289 end do
5290 end do
5291
5292# 1417 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5293#if defined(MFC_OpenACC)
5294# 1417 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5295!$acc end parallel loop
5296# 1417 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5297#elif defined(MFC_OpenMP)
5298# 1417 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5299
5300# 1417 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5301!$omp end target teams loop
5302# 1417 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5303#endif
5304 end if
5305
5306 ! Reshaping/Projecting onto Characteristic Fields in y-direction
5307 if (n == 0) return
5308
5309 if (weno_dir == 2) then
5310
5311# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5312
5313# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5314#if defined(MFC_OpenACC)
5315# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5316!$acc parallel loop collapse(4) gang vector default(present)
5317# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5318#elif defined(MFC_OpenMP)
5319# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5320
5321# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5322
5323# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5324
5325# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5326!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5327# 1424 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5328#endif
5329 do j = 1, v_size
5330 do q = is3_weno%beg, is3_weno%end
5331 do l = is2_weno%beg, is2_weno%end
5332 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
5333 v_rs_ws_y(k, l, q, j) = v_vf(j)%sf(l, k, q)
5334 end do
5335 end do
5336 end do
5337 end do
5338
5339# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5340#if defined(MFC_OpenACC)
5341# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5342!$acc end parallel loop
5343# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5344#elif defined(MFC_OpenMP)
5345# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5346
5347# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5348!$omp end target teams loop
5349# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5350#endif
5351 end if
5352
5353 ! Reshaping/Projecting onto Characteristic Fields in z-direction
5354 if (p == 0) return
5355
5356 if (weno_dir == 3) then
5357
5358# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5359
5360# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5361#if defined(MFC_OpenACC)
5362# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5363!$acc parallel loop collapse(4) gang vector default(present)
5364# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5365#elif defined(MFC_OpenMP)
5366# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5367
5368# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5369
5370# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5371
5372# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5373!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
5374# 1441 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5375#endif
5376 do j = 1, v_size
5377 do q = is3_weno%beg, is3_weno%end
5378 do l = is2_weno%beg, is2_weno%end
5379 do k = is1_weno%beg - weno_polyn, is1_weno%end + weno_polyn
5380 v_rs_ws_z(k, l, q, j) = v_vf(j)%sf(q, l, k)
5381 end do
5382 end do
5383 end do
5384 end do
5385
5386# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5387#if defined(MFC_OpenACC)
5388# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5389!$acc end parallel loop
5390# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5391#elif defined(MFC_OpenMP)
5392# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5393
5394# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5395!$omp end target teams loop
5396# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5397#endif
5398 end if
5399
5400 end subroutine s_initialize_weno
5401
5402 !> Enforce monotonicity-preserving bounds on the WENO reconstruction
5403 subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf)
5404
5405 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: v_rs_ws
5406 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: vL_rs_vf, vR_rs_vf
5407 integer :: i, j, k, l
5408 real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers
5409 real(wp) :: d_MD, d_LC !< Median (md) curvature and large curvature (LC) measures
5410 ! The left and right upper bounds (UL), medians, large curvatures, minima, and maxima of the WENO-reconstructed values of
5411 ! the cell- average variables.
5412 real(wp) :: vL_UL, vR_UL
5413 real(wp) :: vL_MD, vR_MD
5414 real(wp) :: vL_LC, vR_LC
5415 real(wp) :: vL_min, vR_min
5416 real(wp) :: vL_max, vR_max
5417 ! Monotonicity-preserving bounds, Suresh & Huynh JCP (1997)
5418 real(wp), parameter :: alpha = 2._wp !< Max CFL stability parameter (CFL < 1/(1+alpha))
5419 real(wp), parameter :: beta = 4._wp/3._wp !< Local curvature freedom parameter
5420 real(wp), parameter :: alpha_mp = 2._wp
5421 real(wp), parameter :: beta_mp = 4._wp/3._wp
5422
5423
5424# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5425
5426# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5427#if defined(MFC_OpenACC)
5428# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5429!$acc parallel loop collapse(4) gang vector default(present) private(d)
5430# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5431#elif defined(MFC_OpenMP)
5432# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5433
5434# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5435
5436# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5437
5438# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5439!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(d)
5440# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5441#endif
5442 do l = is3_weno%beg, is3_weno%end
5443 do k = is2_weno%beg, is2_weno%end
5444 do j = is1_weno%beg, is1_weno%end
5445 do i = 1, v_size
5446 ! Second-order undivided differences for curvature estimation
5447 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
5448 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
5449 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
5450
5451 ! Median function for oscillation detection
5452 d_md = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5453 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, &
5454 & 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
5455
5456 d_lc = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5457 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5458 & 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
5459
5460 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
5461
5462 vl_md = (v_rs_ws(j, k, l, i) + v_rs_ws(j - 1, k, l, i) - d_md)*5.e-1_wp
5463
5464 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
5465
5466 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, &
5467 & vl_lc))
5468
5469 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, &
5470 & vl_lc))
5471
5472 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, &
5473 & 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)), &
5474 & abs(vl_max - vl_rs_vf(j, k, l, i)))
5475 ! END: Left Monotonicity Preserving Bound
5476
5477 ! Right Monotonicity Preserving Bound
5478 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
5479 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
5480 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
5481
5482 d_md = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0)))*abs((sign(1._wp, &
5483 & 4._wp*d(0) - d(1)) + sign(1._wp, d(0)))*(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, &
5484 & 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
5485
5486 d_lc = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1)))*abs((sign(1._wp, &
5487 & 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1)))*(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, &
5488 & 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
5489
5490 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
5491
5492 vr_md = (v_rs_ws(j, k, l, i) + v_rs_ws(j + 1, k, l, i) - d_md)*5.e-1_wp
5493
5494 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
5495
5496 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, &
5497 & vr_lc))
5498
5499 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, &
5500 & vr_lc))
5501
5502 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, &
5503 & 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)), &
5504 & abs(vr_max - vr_rs_vf(j, k, l, i)))
5505 ! END: Right Monotonicity Preserving Bound
5506 end do
5507 end do
5508 end do
5509 end do
5510
5511# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5512#if defined(MFC_OpenACC)
5513# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5514!$acc end parallel loop
5515# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5516#elif defined(MFC_OpenMP)
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!$omp end target teams loop
5521# 1546 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5522#endif
5523
5524 end subroutine s_preserve_monotonicity
5525
5526 !> Module deallocation and/or disassociation procedures
5527 impure subroutine s_finalize_weno_module()
5528
5529 if (weno_order == 1) return
5530
5531 ! Deallocating the WENO-stencil of the WENO-reconstructed variables
5532
5533#ifdef MFC_DEBUG
5534# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5535 block
5536# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5537 use iso_fortran_env, only: output_unit
5538# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5539
5540# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5541 print *, 'm_weno.fpp:1557: ', '@:DEALLOCATE(v_rs_ws_x)'
5542# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5543
5544# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5545 call flush (output_unit)
5546# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5547 end block
5548# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5549#endif
5550# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5551
5552# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5553#if defined(MFC_OpenACC)
5554# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5555!$acc exit data delete(v_rs_ws_x)
5556# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5557#elif defined(MFC_OpenMP)
5558# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5559!$omp target exit data map(release:v_rs_ws_x)
5560# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5561#endif
5562# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5563 deallocate (v_rs_ws_x)
5564
5565 ! Deallocating WENO coefficients in x-direction
5566#ifdef MFC_DEBUG
5567# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5568 block
5569# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5570 use iso_fortran_env, only: output_unit
5571# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5572
5573# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5574 print *, 'm_weno.fpp:1560: ', '@:DEALLOCATE(poly_coef_cbL_x, poly_coef_cbR_x)'
5575# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5576
5577# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5578 call flush (output_unit)
5579# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5580 end block
5581# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5582#endif
5583# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5584
5585# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5586#if defined(MFC_OpenACC)
5587# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5588!$acc exit data delete(poly_coef_cbL_x, poly_coef_cbR_x)
5589# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5590#elif defined(MFC_OpenMP)
5591# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5592!$omp target exit data map(release:poly_coef_cbL_x, poly_coef_cbR_x)
5593# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5594#endif
5595# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5596 deallocate (poly_coef_cbl_x, poly_coef_cbr_x)
5597#ifdef MFC_DEBUG
5598# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5599 block
5600# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5601 use iso_fortran_env, only: output_unit
5602# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5603
5604# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5605 print *, 'm_weno.fpp:1561: ', '@:DEALLOCATE(d_cbL_x, d_cbR_x)'
5606# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5607
5608# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5609 call flush (output_unit)
5610# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5611 end block
5612# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5613#endif
5614# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5615
5616# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5617#if defined(MFC_OpenACC)
5618# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5619!$acc exit data delete(d_cbL_x, d_cbR_x)
5620# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5621#elif defined(MFC_OpenMP)
5622# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5623!$omp target exit data map(release:d_cbL_x, d_cbR_x)
5624# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5625#endif
5626# 1561 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5627 deallocate (d_cbl_x, d_cbr_x)
5628#ifdef MFC_DEBUG
5629# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5630 block
5631# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5632 use iso_fortran_env, only: output_unit
5633# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5634
5635# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5636 print *, 'm_weno.fpp:1562: ', '@:DEALLOCATE(beta_coef_x)'
5637# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5638
5639# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5640 call flush (output_unit)
5641# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5642 end block
5643# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5644#endif
5645# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5646
5647# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5648#if defined(MFC_OpenACC)
5649# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5650!$acc exit data delete(beta_coef_x)
5651# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5652#elif defined(MFC_OpenMP)
5653# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5654!$omp target exit data map(release:beta_coef_x)
5655# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5656#endif
5657# 1562 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5658 deallocate (beta_coef_x)
5659
5660 ! Deallocating WENO coefficients in y-direction
5661 if (n == 0) return
5662
5663#ifdef MFC_DEBUG
5664# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5665 block
5666# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5667 use iso_fortran_env, only: output_unit
5668# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5669
5670# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5671 print *, 'm_weno.fpp:1567: ', '@:DEALLOCATE(v_rs_ws_y)'
5672# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5673
5674# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5675 call flush (output_unit)
5676# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5677 end block
5678# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5679#endif
5680# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5681
5682# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5683#if defined(MFC_OpenACC)
5684# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5685!$acc exit data delete(v_rs_ws_y)
5686# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5687#elif defined(MFC_OpenMP)
5688# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5689!$omp target exit data map(release:v_rs_ws_y)
5690# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5691#endif
5692# 1567 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5693 deallocate (v_rs_ws_y)
5694
5695#ifdef MFC_DEBUG
5696# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5697 block
5698# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5699 use iso_fortran_env, only: output_unit
5700# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5701
5702# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5703 print *, 'm_weno.fpp:1569: ', '@:DEALLOCATE(poly_coef_cbL_y, poly_coef_cbR_y)'
5704# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5705
5706# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5707 call flush (output_unit)
5708# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5709 end block
5710# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5711#endif
5712# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5713
5714# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5715#if defined(MFC_OpenACC)
5716# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5717!$acc exit data delete(poly_coef_cbL_y, poly_coef_cbR_y)
5718# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5719#elif defined(MFC_OpenMP)
5720# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5721!$omp target exit data map(release:poly_coef_cbL_y, poly_coef_cbR_y)
5722# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5723#endif
5724# 1569 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5725 deallocate (poly_coef_cbl_y, poly_coef_cbr_y)
5726#ifdef MFC_DEBUG
5727# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5728 block
5729# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5730 use iso_fortran_env, only: output_unit
5731# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5732
5733# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5734 print *, 'm_weno.fpp:1570: ', '@:DEALLOCATE(d_cbL_y, d_cbR_y)'
5735# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5736
5737# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5738 call flush (output_unit)
5739# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5740 end block
5741# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5742#endif
5743# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5744
5745# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5746#if defined(MFC_OpenACC)
5747# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5748!$acc exit data delete(d_cbL_y, d_cbR_y)
5749# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5750#elif defined(MFC_OpenMP)
5751# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5752!$omp target exit data map(release:d_cbL_y, d_cbR_y)
5753# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5754#endif
5755# 1570 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5756 deallocate (d_cbl_y, d_cbr_y)
5757#ifdef MFC_DEBUG
5758# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5759 block
5760# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5761 use iso_fortran_env, only: output_unit
5762# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5763
5764# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5765 print *, 'm_weno.fpp:1571: ', '@:DEALLOCATE(beta_coef_y)'
5766# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5767
5768# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5769 call flush (output_unit)
5770# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5771 end block
5772# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5773#endif
5774# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5775
5776# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5777#if defined(MFC_OpenACC)
5778# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5779!$acc exit data delete(beta_coef_y)
5780# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5781#elif defined(MFC_OpenMP)
5782# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5783!$omp target exit data map(release:beta_coef_y)
5784# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5785#endif
5786# 1571 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5787 deallocate (beta_coef_y)
5788
5789 ! Deallocating WENO coefficients in z-direction
5790 if (p == 0) return
5791
5792#ifdef MFC_DEBUG
5793# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5794 block
5795# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5796 use iso_fortran_env, only: output_unit
5797# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5798
5799# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5800 print *, 'm_weno.fpp:1576: ', '@:DEALLOCATE(v_rs_ws_z)'
5801# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5802
5803# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5804 call flush (output_unit)
5805# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5806 end block
5807# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5808#endif
5809# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5810
5811# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5812#if defined(MFC_OpenACC)
5813# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5814!$acc exit data delete(v_rs_ws_z)
5815# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5816#elif defined(MFC_OpenMP)
5817# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5818!$omp target exit data map(release:v_rs_ws_z)
5819# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5820#endif
5821# 1576 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5822 deallocate (v_rs_ws_z)
5823
5824#ifdef MFC_DEBUG
5825# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5826 block
5827# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5828 use iso_fortran_env, only: output_unit
5829# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5830
5831# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5832 print *, 'm_weno.fpp:1578: ', '@:DEALLOCATE(poly_coef_cbL_z, poly_coef_cbR_z)'
5833# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5834
5835# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5836 call flush (output_unit)
5837# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5838 end block
5839# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5840#endif
5841# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5842
5843# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5844#if defined(MFC_OpenACC)
5845# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5846!$acc exit data delete(poly_coef_cbL_z, poly_coef_cbR_z)
5847# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5848#elif defined(MFC_OpenMP)
5849# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5850!$omp target exit data map(release:poly_coef_cbL_z, poly_coef_cbR_z)
5851# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5852#endif
5853# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5854 deallocate (poly_coef_cbl_z, poly_coef_cbr_z)
5855#ifdef MFC_DEBUG
5856# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5857 block
5858# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5859 use iso_fortran_env, only: output_unit
5860# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5861
5862# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5863 print *, 'm_weno.fpp:1579: ', '@:DEALLOCATE(d_cbL_z, d_cbR_z)'
5864# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5865
5866# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5867 call flush (output_unit)
5868# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5869 end block
5870# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5871#endif
5872# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5873
5874# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5875#if defined(MFC_OpenACC)
5876# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5877!$acc exit data delete(d_cbL_z, d_cbR_z)
5878# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5879#elif defined(MFC_OpenMP)
5880# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5881!$omp target exit data map(release:d_cbL_z, d_cbR_z)
5882# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5883#endif
5884# 1579 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5885 deallocate (d_cbl_z, d_cbr_z)
5886#ifdef MFC_DEBUG
5887# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5888 block
5889# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5890 use iso_fortran_env, only: output_unit
5891# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5892
5893# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5894 print *, 'm_weno.fpp:1580: ', '@:DEALLOCATE(beta_coef_z)'
5895# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5896
5897# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5898 call flush (output_unit)
5899# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5900 end block
5901# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5902#endif
5903# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5904
5905# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5906#if defined(MFC_OpenACC)
5907# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5908!$acc exit data delete(beta_coef_z)
5909# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5910#elif defined(MFC_OpenMP)
5911# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5912!$omp target exit data map(release:beta_coef_z)
5913# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5914#endif
5915# 1580 "/home/runner/work/MFC/MFC/src/simulation/m_weno.fpp"
5916 deallocate (beta_coef_z)
5917
5918 end subroutine s_finalize_weno_module
5919
5920end module m_weno
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
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:904
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:5404
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:5242
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:5528
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:411