diff --git a/docs/documentation/case.md b/docs/documentation/case.md index b92e8f945e..187bab00c7 100644 --- a/docs/documentation/case.md +++ b/docs/documentation/case.md @@ -146,13 +146,13 @@ When the simulation is 2D/axi-symmetric or 1D, it requires that $p=0$ or $p=n=0$ - `stretch_[x,y,z]` activates grid stretching in the $[x,y,z]$ directions. The grid is gradually stretched such that the domain boundaries are pushed away from the origin along a specified axis. -- `a_[x,y,z]`, `[x,y,z]_a`, and `[x,y,z]_b` are parameters that define the grid stretching function. When grid stretching along the $x$ axis is considered, the stretching function is given as: +- `a_[x,y,z]`, `[x,y,z]_stretch%%beg`, and `[x,y,z]_stretch%%end` (where `beg` is the negative-direction anchor and `end` the positive-direction anchor) are parameters that define the grid stretching function. When grid stretching along the $x$ axis is considered, the stretching function is given as: -\f[ x_{cb,stretch} = x_{cb} + \frac{x_{cb}}{a_x} \Bigg[ \mathrm{log}\left[\mathrm{cosh} \left( \frac{a_x(x_{cb}-x_a)}{L} \right) \right] + \mathrm{log}\left[\mathrm{cosh} \left( \frac{a_x(x_{cb}-x_b)}{L} \right) \right] -2 \mathrm{log}\left[\mathrm{cosh} \left( \frac{a_x(x_b-x_a)}{2L} \right) \right] \Bigg] \f] +\f[ x_{cb,stretch} = x_{cb} + \frac{x_{cb}}{a_x} \Bigg[ \mathrm{log}\left[\mathrm{cosh} \left( \frac{a_x(x_{cb}-x_{stretch,beg})}{L} \right) \right] + \mathrm{log}\left[\mathrm{cosh} \left( \frac{a_x(x_{cb}-x_{stretch,end})}{L} \right) \right] -2 \mathrm{log}\left[\mathrm{cosh} \left( \frac{a_x(x_{stretch,end}-x_{stretch,beg})}{2L} \right) \right] \Bigg] \f] where `x_cb` and `x_[cb,stretch]` are the coordinates of a cell boundary at the original and stretched domains, respectively. `L` is the domain length along the `x` axis: `L`=`x_domain%%end`-`x_domain%%beg`. -Crudely speaking, `x_a` and `x_b` define the coordinates at which the grid begins to get stretched in the negative and positive directions along the $x$ axis, respectively. +Crudely speaking, `x_stretch%%beg` and `x_stretch%%end` define the coordinates at which the grid begins to get stretched in the negative and positive directions along the $x$ axis, respectively. $a_x$ defines the smoothness of the stretching. Stretching along the $y$ and $z$ axes follows the same logistics. Optimal choice of the parameters for grid stretching is case-dependent and left to the user. @@ -987,15 +987,15 @@ This parameter enables the use of true `pi_\infty` in bubble dynamics models whe | Parameter | Type | Description | | ---: | :---: | :--- | -| `bf_x[y,z]` | Logical | Enable body forces in the x[y,z] direction | -| `k_x[y,y]` | Real | Magnitude of oscillating acceleration | -| `w_x[y,z]` | Real | Frequency of oscillating acceleration | -| `p_x[y,z]` | Real | Phase shift of oscillating acceleration | -| `g_x[y,z]` | Real | Magnitude of background acceleration | +| `bf_[x,y,z]%%enabled` | Logical | Enable body forces in the [x,y,z] direction | +| `bf_[x,y,z]%%k` | Real | Magnitude of oscillating acceleration | +| `bf_[x,y,z]%%w` | Real | Frequency of oscillating acceleration | +| `bf_[x,y,z]%%p` | Real | Phase shift of oscillating acceleration | +| `bf_[x,y,z]%%g` | Real | Magnitude of background acceleration | -`k_x[y,z]`, `w_x[y,z]`, `p_x[y,z]`, and `g_x[y,z]` define an oscillating acceleration in the `x[y,z]` direction with the form +`bf_[x,y,z]%%k`, `bf_[x,y,z]%%w`, `bf_[x,y,z]%%p`, and `bf_[x,y,z]%%g` define an oscillating acceleration in the `[x,y,z]` direction with the form -\f[ a_{x[y,z]} = g_{x[y,z]} + k_{x[y,z]}\sin\left(w_{x[y,z]}t + p_{x[y,z]}\right). \f] +\f[ a_{[x,y,z]} = bf_{[x,y,z]}\%g + bf_{[x,y,z]}\%k\sin\left(bf_{[x,y,z]}\%w \cdot t + bf_{[x,y,z]}\%p\right). \f] By convention, positive accelerations in the `x[y,z]` direction are in the positive `x[y,z]` direction. diff --git a/examples/2D_axisym_shockwatercavity/case.py b/examples/2D_axisym_shockwatercavity/case.py index b331322e76..38d2cd2aa5 100644 --- a/examples/2D_axisym_shockwatercavity/case.py +++ b/examples/2D_axisym_shockwatercavity/case.py @@ -161,12 +161,12 @@ "y_domain%end": ye, "stretch_x": "T", "a_x": 20, - "x_a": -1.2 * D0, - "x_b": 1.2 * D0, + "x_stretch%beg": -1.2 * D0, + "x_stretch%end": 1.2 * D0, "stretch_y": "T", "a_y": 20, - "y_a": -0.0 * D0, - "y_b": 1.2 * D0, + "y_stretch%beg": -0.0 * D0, + "y_stretch%end": 1.2 * D0, "m": Nx, "n": Ny, "p": 0, diff --git a/examples/2D_hardcoded_ic/case.py b/examples/2D_hardcoded_ic/case.py index e26e01f8ac..7e1fd1eb6e 100644 --- a/examples/2D_hardcoded_ic/case.py +++ b/examples/2D_hardcoded_ic/case.py @@ -14,14 +14,14 @@ "x_domain%end": 4.0e00, "stretch_x": "T", "a_x": 7, - "x_a": -2, - "x_b": 2, + "x_stretch%beg": -2, + "x_stretch%end": 2, "y_domain%beg": 0.0e00, "y_domain%end": 4.0e00, "stretch_y": "T", "a_y": 7, - "y_a": -2, - "y_b": 2, + "y_stretch%beg": -2, + "y_stretch%end": 2, "m": 199, "n": 199, "p": 0, diff --git a/examples/2D_isentropicvortex/case.py b/examples/2D_isentropicvortex/case.py index 6bbffcd45c..c1d80a63b1 100644 --- a/examples/2D_isentropicvortex/case.py +++ b/examples/2D_isentropicvortex/case.py @@ -57,10 +57,10 @@ "loops_y": 2, "a_x": 1.03, "a_y": 1.03, - "x_a": -1.5, - "y_a": -1.5, - "x_b": 1.5, - "y_b": 1.5, + "x_stretch%beg": -1.5, + "y_stretch%beg": -1.5, + "x_stretch%end": 1.5, + "y_stretch%end": 1.5, "m": Nx, "n": Nx, "p": 0, diff --git a/examples/2D_isentropicvortex_analytical/case.py b/examples/2D_isentropicvortex_analytical/case.py index ba31fb491c..84e8bddb2a 100644 --- a/examples/2D_isentropicvortex_analytical/case.py +++ b/examples/2D_isentropicvortex_analytical/case.py @@ -57,10 +57,10 @@ "loops_y": 2, "a_x": 1.03, "a_y": 1.03, - "x_a": -1.5, - "y_a": -1.5, - "x_b": 1.5, - "y_b": 1.5, + "x_stretch%beg": -1.5, + "y_stretch%beg": -1.5, + "x_stretch%end": 1.5, + "y_stretch%end": 1.5, "m": Nx, "n": Nx, "p": 0, diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py index c7b782daab..4ec49144fe 100644 --- a/examples/2D_phasechange_bubble/case.py +++ b/examples/2D_phasechange_bubble/case.py @@ -191,13 +191,13 @@ "stretch_x": "T", "loops_x": 3, "a_x": 4.0e0, - "x_a": -2.0 * R0, - "x_b": 2.0 * R0, + "x_stretch%beg": -2.0 * R0, + "x_stretch%end": 2.0 * R0, "stretch_y": "T", "loops_y": 3, "a_y": 4.0e0, - "y_a": -2.0 * R0, - "y_b": 2.0 * R0, + "y_stretch%beg": -2.0 * R0, + "y_stretch%end": 2.0 * R0, "cyl_coord": "T", "m": Nx, "n": Ny, diff --git a/examples/2D_rayleigh_taylor/case.py b/examples/2D_rayleigh_taylor/case.py index ab7d9267db..498daadbcd 100644 --- a/examples/2D_rayleigh_taylor/case.py +++ b/examples/2D_rayleigh_taylor/case.py @@ -79,11 +79,11 @@ "fluid_pp(2)%pi_inf": 0.0e00, "fluid_pp(2)%Re(1)": 1 / 0.0073, # Body Forces - "bf_y": "T", - "k_y": 0.0, - "w_y": 0.0, - "p_y": 0.0, - "g_y": -9.81, + "bf_y%enabled": "T", + "bf_y%k": 0.0, + "bf_y%w": 0.0, + "bf_y%p": 0.0, + "bf_y%g": -9.81, # Water Patch "patch_icpp(1)%geometry": 3, "patch_icpp(1)%hcid": 204, diff --git a/examples/2D_shockdroplet/case.py b/examples/2D_shockdroplet/case.py index 910d1e42aa..f75e2296df 100755 --- a/examples/2D_shockdroplet/case.py +++ b/examples/2D_shockdroplet/case.py @@ -38,8 +38,8 @@ "y_domain%end": 6 * D, "stretch_y": "T", "a_y": 3.67, - "y_a": -5.7 * D, - "y_b": 5.7 * D, + "y_stretch%beg": -5.7 * D, + "y_stretch%end": 5.7 * D, "loops_y": 2, "m": int(Nx), "n": int(Ny), diff --git a/examples/2D_shockdroplet_muscl/case.py b/examples/2D_shockdroplet_muscl/case.py index e27e13aefe..0de30d0529 100755 --- a/examples/2D_shockdroplet_muscl/case.py +++ b/examples/2D_shockdroplet_muscl/case.py @@ -38,8 +38,8 @@ "y_domain%end": 6 * D, "stretch_y": "T", "a_y": 3.67, - "y_a": -5.7 * D, - "y_b": 5.7 * D, + "y_stretch%beg": -5.7 * D, + "y_stretch%end": 5.7 * D, "loops_y": 2, "m": int(Nx), "n": int(Ny), diff --git a/examples/3D_performance_test/case.py b/examples/3D_performance_test/case.py index 4d4a4dc4b5..f851865759 100644 --- a/examples/3D_performance_test/case.py +++ b/examples/3D_performance_test/case.py @@ -16,16 +16,16 @@ "z_domain%end": 4.0e-03 / 1.0e-03, "stretch_x": "T", "a_x": 4.0e00, - "x_a": -1.5e-03 / 1.0e-03, - "x_b": 1.5e-03 / 1.0e-03, + "x_stretch%beg": -1.5e-03 / 1.0e-03, + "x_stretch%end": 1.5e-03 / 1.0e-03, "stretch_y": "T", "a_y": 4.0e00, - "y_a": -1.5e-03 / 1.0e-03, - "y_b": 1.5e-03 / 1.0e-03, + "y_stretch%beg": -1.5e-03 / 1.0e-03, + "y_stretch%end": 1.5e-03 / 1.0e-03, "stretch_z": "T", "a_z": 4.0e00, - "z_a": -1.5e-03 / 1.0e-03, - "z_b": 1.5e-03 / 1.0e-03, + "z_stretch%beg": -1.5e-03 / 1.0e-03, + "z_stretch%end": 1.5e-03 / 1.0e-03, "cyl_coord": "F", "m": 200, "n": 200, diff --git a/examples/3D_phasechange_bubble/case.py b/examples/3D_phasechange_bubble/case.py index 6c71aa1936..9d9fbf6d34 100644 --- a/examples/3D_phasechange_bubble/case.py +++ b/examples/3D_phasechange_bubble/case.py @@ -193,18 +193,18 @@ "stretch_x": "T", "loops_x": 3, "a_x": 4.0e0, - "x_a": -2.0 * R0, - "x_b": 2.0 * R0, + "x_stretch%beg": -2.0 * R0, + "x_stretch%end": 2.0 * R0, "stretch_y": "T", "loops_y": 3, "a_y": 4.0e0, - "y_a": -2.0 * R0, - "y_b": 2.0 * R0, + "y_stretch%beg": -2.0 * R0, + "y_stretch%end": 2.0 * R0, "stretch_z": "T", "loops_z": 3, "a_z": 4.0e0, - "z_a": -2.0 * R0, - "z_b": 2.0 * R0, + "z_stretch%beg": -2.0 * R0, + "z_stretch%end": 2.0 * R0, "cyl_coord": "F", "m": Nx, "n": Ny, diff --git a/examples/3D_rayleigh_taylor/case.py b/examples/3D_rayleigh_taylor/case.py index 647127426d..74d1e838a7 100644 --- a/examples/3D_rayleigh_taylor/case.py +++ b/examples/3D_rayleigh_taylor/case.py @@ -86,11 +86,11 @@ "fluid_pp(2)%pi_inf": 0.0e00, "fluid_pp(2)%Re(1)": 1 / 0.0073, # Body Forces - "bf_y": "T", - "k_y": 0.0, - "w_y": 0.0, - "p_y": 0.0, - "g_y": -98.1, + "bf_y%enabled": "T", + "bf_y%k": 0.0, + "bf_y%w": 0.0, + "bf_y%p": 0.0, + "bf_y%g": -98.1, # Water Patch "patch_icpp(1)%geometry": 9, "patch_icpp(1)%hcid": 300, diff --git a/examples/3D_rayleigh_taylor_muscl/case.py b/examples/3D_rayleigh_taylor_muscl/case.py index f93248383c..e9f2ce8b32 100644 --- a/examples/3D_rayleigh_taylor_muscl/case.py +++ b/examples/3D_rayleigh_taylor_muscl/case.py @@ -84,11 +84,11 @@ "fluid_pp(2)%pi_inf": 0.0e00, "fluid_pp(2)%Re(1)": 1 / 0.0073, # Body Forces - "bf_y": "T", - "k_y": 0.0, - "w_y": 0.0, - "p_y": 0.0, - "g_y": -98.1, + "bf_y%enabled": "T", + "bf_y%k": 0.0, + "bf_y%w": 0.0, + "bf_y%p": 0.0, + "bf_y%g": -98.1, # Water Patch "patch_icpp(1)%geometry": 9, "patch_icpp(1)%hcid": 300, diff --git a/examples/3D_shockdroplet/case.py b/examples/3D_shockdroplet/case.py index 10741bc82e..bd1c663e67 100644 --- a/examples/3D_shockdroplet/case.py +++ b/examples/3D_shockdroplet/case.py @@ -173,16 +173,16 @@ "z_domain%end": ze, "stretch_x": "T", "a_x": 20, - "x_a": -1.2 * D0, - "x_b": 1.2 * D0, + "x_stretch%beg": -1.2 * D0, + "x_stretch%end": 1.2 * D0, "stretch_y": "T", "a_y": 20, - "y_a": -0.0 * D0, - "y_b": 1.2 * D0, + "y_stretch%beg": -0.0 * D0, + "y_stretch%end": 1.2 * D0, "stretch_z": "T", "a_z": 20, - "z_a": -0.0 * D0, - "z_b": 1.2 * D0, + "z_stretch%beg": -0.0 * D0, + "z_stretch%end": 1.2 * D0, "m": Nx, "n": Ny, "p": Nz, diff --git a/examples/3D_shockdroplet_muscl/case.py b/examples/3D_shockdroplet_muscl/case.py index d1defd1e5d..e478f65046 100644 --- a/examples/3D_shockdroplet_muscl/case.py +++ b/examples/3D_shockdroplet_muscl/case.py @@ -173,16 +173,16 @@ "z_domain%end": ze, "stretch_x": "T", "a_x": 20, - "x_a": -1.2 * D0, - "x_b": 1.2 * D0, + "x_stretch%beg": -1.2 * D0, + "x_stretch%end": 1.2 * D0, "stretch_y": "T", "a_y": 20, - "y_a": -0.0 * D0, - "y_b": 1.2 * D0, + "y_stretch%beg": -0.0 * D0, + "y_stretch%end": 1.2 * D0, "stretch_z": "T", "a_z": 20, - "z_a": -0.0 * D0, - "z_b": 1.2 * D0, + "z_stretch%beg": -0.0 * D0, + "z_stretch%end": 1.2 * D0, "m": Nx, "n": Ny, "p": Nz, diff --git a/examples/3D_sphbubcollapse/case.py b/examples/3D_sphbubcollapse/case.py index d22975494b..95b92135d2 100644 --- a/examples/3D_sphbubcollapse/case.py +++ b/examples/3D_sphbubcollapse/case.py @@ -23,16 +23,16 @@ # away from the bubble / origin "stretch_x": "T", "a_x": 4.0e00, - "x_a": -1.5e-03 / 1.0e-03, - "x_b": 1.5e-03 / 1.0e-03, + "x_stretch%beg": -1.5e-03 / 1.0e-03, + "x_stretch%end": 1.5e-03 / 1.0e-03, "stretch_y": "T", "a_y": 4.0e00, - "y_a": -1.5e-03 / 1.0e-03, - "y_b": 1.5e-03 / 1.0e-03, + "y_stretch%beg": -1.5e-03 / 1.0e-03, + "y_stretch%end": 1.5e-03 / 1.0e-03, "stretch_z": "T", "a_z": 4.0e00, - "z_a": -1.5e-03 / 1.0e-03, - "z_b": 1.5e-03 / 1.0e-03, + "z_stretch%beg": -1.5e-03 / 1.0e-03, + "z_stretch%end": 1.5e-03 / 1.0e-03, "cyl_coord": "F", "m": 99, "n": 99, diff --git a/examples/3D_turb_mixing/case.py b/examples/3D_turb_mixing/case.py index f4b8a0c486..5ef0adc43b 100644 --- a/examples/3D_turb_mixing/case.py +++ b/examples/3D_turb_mixing/case.py @@ -54,8 +54,8 @@ "y_domain%end": Ly / 2.0, "stretch_y": "T", "a_y": 2, - "y_a": -0.3 * Ly, - "y_b": 0.3 * Ly, + "y_stretch%beg": -0.3 * Ly, + "y_stretch%end": 0.3 * Ly, "loops_y": 2, "z_domain%beg": 0.0, "z_domain%end": Lz, diff --git a/src/common/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp index bcb44edd0b..e812d9ea4a 100644 --- a/src/common/include/1dHardcodedIC.fpp +++ b/src/common/include/1dHardcodedIC.fpp @@ -7,12 +7,12 @@ select case (patch_icpp(patch_id)%hcid) case (150) ! 1D Smooth Alfven Case for MHD ! velocity - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) - q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x%cc(i)) + q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x%cc(i)) ! magnetic field - q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) - q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x%cc(i)) + q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x%cc(i)) case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox) ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera, ! SDtoolbox) @@ -21,17 +21,17 @@ ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 + ! 0.2*sin(5*x)" if (patch_id == 2) then - q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i)) + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x%cc(i)) end if case (181) ! Titarev-Torro problem ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)": ! "1 + 0.1*sin(20*x*pi)" - q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi) + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x%cc(i)*pi) case (182) ! Multi-component diffusion ! This patch is a hard-coded for test suite optimization (multiple component diffusion) x_mid_diffu = 0.05_wp/2.0_wp width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2 - profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq) + profile_shape = 1.0_wp - 0.5_wp*exp(-(x%cc(i) - x_mid_diffu)**2/width_sq) q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp @@ -58,10 +58,10 @@ q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp - if (x_cc(i) <= 0.025_wp) then - temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i) + if (x%cc(i) <= 0.025_wp) then + temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x%cc(i) else - temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp) + temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x%cc(i) - 0.025_wp) end if molar_mass_inv = 1.0_wp/2.01588_wp diff --git a/src/common/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp index d6c3fed97f..0f9a33c33b 100644 --- a/src/common/include/2dHardcodedIC.fpp +++ b/src/common/include/2dHardcodedIC.fpp @@ -33,7 +33,7 @@ #:def Hardcoded2D() select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case case (200) ! Two-fluid cubic interface - if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then + if (y%cc(j) <= (-x%cc(i)**3 + 1)**(1._wp/3._wp)) then ! Volume Fractions q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps @@ -42,7 +42,7 @@ q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp end if case (202) ! Gresho vortex (Gouasmi et al 2022 JCP) - r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp + r = ((x%cc(i) - 0.5_wp)**2 + (y%cc(j) - 0.5_wp)**2)**0.5_wp rmax = 0.2_wp gam = 1._wp + 1._wp/fluid_pp(1)%gamma @@ -50,12 +50,12 @@ p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp) if (r < rmax) then - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax - q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y%cc(j) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x%cc(i) - 0.5_wp)*umax/rmax q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) else if (r < 2*rmax) then - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y%cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x%cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) else q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp @@ -63,7 +63,7 @@ q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp)) end if case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction - r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp + r = ((x%cc(i) - 0.5_wp)**2._wp + (y%cc(j) - 0.5_wp)**2)**0.5_wp rmax = 0.2_wp gam = 1._wp + 1._wp/fluid_pp(1)%gamma @@ -71,12 +71,12 @@ p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp) if (r < rmax) then - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax - q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y%cc(j) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x%cc(i) - 0.5_wp)*umax/rmax q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) else if (r < 2*rmax) then - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y%cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x%cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax))) else q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp @@ -95,35 +95,35 @@ wl = 2._wp*pi/lam amp = 0.05_wp/wl - intH = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h + intH = amp*sin(2._wp*pi*x%cc(i)/lam - pi/2._wp) + h - alph = 0.5_wp*(1._wp + tanh((y_cc(j) - intH)/2.5e-3_wp)) + alph = 0.5_wp*(1._wp + tanh((y%cc(j) - intH)/2.5e-3_wp)) if (alph < eps) alph = eps if (alph > 1._wp - eps) alph = 1._wp - eps - if (y_cc(j) > intH) then + if (y%cc(j) > intH) then q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoH q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhoL - q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y%cc(j)) else q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoH q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhoL pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y%cc(j)) end if case (205) ! 2D lung wave interaction problem h = 0.0_wp ! non dim origin y lam = 1.0_wp ! non dim lambda amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude - intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h + intH = amp*sin(2*pi*x%cc(i)/lam - pi/2) + h - if (y_cc(j) > intH) then + if (y%cc(j) > intH) then q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres @@ -135,9 +135,9 @@ lam = 1.0_wp ! non dim lambda amp = patch_icpp(patch_id)%a(2) - intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h + intL = amp*sin(2*pi*y%cc(j)/lam - pi/2) + h - if (x_cc(i) > intL) then ! this is the liquid + if (x%cc(i) > intL) then ! this is the liquid q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres @@ -146,17 +146,21 @@ end if case (207) ! Kelvin Helmholtz Instability sigma = 0.05_wp/sqrt(2.0_wp) - gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2)) - gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2)) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2) + gauss1 = exp(-(y%cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2)) + gauss2 = exp(-(y%cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x%cc(i))*(gauss1 + gauss2) case (208) ! Richtmeyer Meshkov Instability lam = 1.0_wp eps = 1.0e-6_wp ei = 5.0_wp ! Smoothening function to smooth out sharp discontinuity in the interface - if (x_cc(i) <= 0.7_wp*lam) then - d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp))) + if (x%cc(i) <= 0.7_wp*lam) then + d = x%cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y%cc(j)/lam + 0.25_wp))) +#ifdef MFC_PRE_PROCESS fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy)))) +#else + fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(x%spacing(i)*y%spacing(j))))) +#endif alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm alpha_sf6 = 1.0_wp - alpha_air q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp @@ -168,18 +172,18 @@ ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi), ! sin(4*pi*x)/sqrt(4*pi), 0) - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j)) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y%cc(j)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x%cc(i)) - q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi) - q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi) + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y%cc(j))/sqrt(4._wp*pi) + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x%cc(i))/sqrt(4._wp*pi) case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1] - if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then + if (x%cc(i)**2 + y%cc(j)**2 < 0.08_wp**2) then q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0 - else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then + else if (x%cc(i)**2 + y%cc(j)**2 <= 1._wp**2) then ! Linear interpolation between r=0.08 and r=1.0 - factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp) + factor = (1.0_wp - sqrt(x%cc(i)**2 + y%cc(j)**2))/(1.0_wp - 0.08_wp) q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor) q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor) else @@ -195,7 +199,7 @@ ! velocity w=20, giving v_tan=2 at r=0.1 ! Calculate distance squared from the center - r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2 + r_sq = (x%cc(i) - 0.5_wp)**2 + (y%cc(j) - 0.5_wp)**2 ! inner radius of 0.1 if (r_sq <= 0.1**2) then @@ -203,32 +207,32 @@ q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c) - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y%cc(j) - 0.5_wp) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x%cc(i) - 0.5_wp) ! taper width of 0.015 else if (r_sq <= 0.115**2) then ! linearly smooth the function between r = 0.1 and 0.115 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp) - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y%cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x%cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) end if case (253) ! MHD Smooth Magnetic Vortex ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P. ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire ! velocity - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y%cc(j)*exp(1 - (x%cc(i)**2 + y%cc(j)**2))/(2.*pi)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x%cc(i)*exp(1 - (x%cc(i)**2 + y%cc(j)**2))/(2.*pi)) ! magnetic field - q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) - q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y%cc(j)*exp(1 - (x%cc(i)**2 + y%cc(j)**2))/(2.*pi) + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x%cc(i)*exp(1 - (x%cc(i)**2 + y%cc(j)**2))/(2.*pi) ! pressure q_prim_vf(eqn_idx%E)%sf(i, j, & - & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3) + & 0) = 1._wp + (1 - 2._wp*(x%cc(i)**2 + y%cc(j)**2))*exp(1 - (x%cc(i)**2 + y%cc(j)**2))/((2._wp*pi)**3) case (260) ! Gaussian Divergence Pulse ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma) ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is @@ -239,10 +243,10 @@ C_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp ! B-field - q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + C_mhd*erf((x_cc(i) - 0.5_wp)/sigma) + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + C_mhd*erf((x%cc(i) - 0.5_wp)/sigma) case (261) ! Blob r0 = 1._wp/sqrt(8._wp) - r2 = x_cc(i)**2 + y_cc(j)**2 + r2 = x%cc(i)**2 + y%cc(j)**2 r = sqrt(r2) alpha = r/r0 if (alpha < 1) then @@ -257,7 +261,7 @@ cosA = cos(alpha) sinA = sin(alpha) ! projection along shock normal - r = x_cc(i)*cosA + y_cc(j)*sinA + r = x%cc(i)*cosA + y%cc(j)*sinA if (r <= 0.5_wp) then ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi) @@ -285,39 +289,39 @@ ! geometry 2 if (patch_id == 1) then q_prim_vf(eqn_idx%E)%sf(i, j, & - & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) & - & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0) + & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x%cc(i) & + & - patch_icpp(1)%x_centroid)**2.0 - (y%cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0) q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, & - & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) & - & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4 + & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x%cc(i) & + & - patch_icpp(1)%x_centroid)**2.0 - (y%cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, & - & 0) = patch_icpp(1)%vel(1) + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) & - & - patch_icpp(1) %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)) + & 0) = patch_icpp(1)%vel(1) + (y%cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x%cc(i) & + & - patch_icpp(1) %x_centroid)**2.0 - (y%cc(j) - patch_icpp(1)%y_centroid)**2.0)) q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, & - & 0) = patch_icpp(1)%vel(2) - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) & - & - patch_icpp(1) %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)) + & 0) = patch_icpp(1)%vel(2) - (x%cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x%cc(i) & + & - patch_icpp(1) %x_centroid)**2.0 - (y%cc(j) - patch_icpp(1)%y_centroid)**2.0)) end if case (281) ! Acoustic pulse ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses ! geometry 2 if (patch_id == 2) then q_prim_vf(eqn_idx%E)%sf(i, j, & - & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1)) + & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x%cc(i)**2 + y%cc(j)**2))))**(1.4/(1.4 - 1)) q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, & - & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1)) + & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x%cc(i)**2 + y%cc(j)**2))))**(1/(1.4 - 1)) end if case (282) ! Zero-circulation vortex ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses ! geometry 2 if (patch_id == 2) then q_prim_vf(eqn_idx%E)%sf(i, j, & - & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1)) + & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x%cc(i)**2 + y%cc(j)**2))))**(1.4/(1.4 - 1)) q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, & - & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1)) + & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x%cc(i)**2 + y%cc(j)**2))))**(1/(1.4 - 1)) q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, & - & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))) + & 0) = 112.99092883944267*(1 - (0.1/0.3))*y%cc(j)*exp(0.5*(1 - sqrt(x%cc(i)**2 + y%cc(j)**2))) q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, & - & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))) + & 0) = 112.99092883944267*((0.1/0.3))*x%cc(i)*exp(0.5*(1 - sqrt(x%cc(i)**2 + y%cc(j)**2))) end if case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product) ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging @@ -331,8 +335,8 @@ rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; E_avg = 0._wp do igq = 1, 3 do jgq = 1, 3 - xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp - yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp + xq = x%cc(i) + gauss_xi(igq)*(x%cb(i) - x%cb(i - 1))*0.5_wp + yq = y%cc(j) + gauss_xi(jgq)*(y%cb(j) - y%cb(j - 1))*0.5_wp r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp T_facq = 1._wp - (vortex_eps/(2._wp*pi))*(vortex_eps/(8._wp*(1.4_wp + 1._wp)*pi))*exp(2._wp*(1._wp - r2q)) wq = gauss_w(igq)*gauss_w(jgq) @@ -375,8 +379,8 @@ Y_N2 = 0.767_wp Y_O2 = 0.233_wp R_mix = 8.314462618_wp*((Y_N2/MW_N2) + (Y_O2/MW_O2)) - bottom_blend_u = tanh(y_cc(j)/delta_shear) - bottom_blend_T = tanh(y_cc(j)/delta_th) + bottom_blend_u = tanh(y%cc(j)/delta_shear) + bottom_blend_T = tanh(y%cc(j)/delta_th) u_mean = u_max*bottom_blend_u T_loc = T_wall + (T_inf - T_wall)*bottom_blend_T q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = P_atm/(R_mix*T_loc) diff --git a/src/common/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp index 6f4be25f56..22310283a8 100644 --- a/src/common/include/3dHardcodedIC.fpp +++ b/src/common/include/3dHardcodedIC.fpp @@ -55,7 +55,7 @@ do l = 0, n rcut = 0._wp do s = 0, NJet - 1 - r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp) + r = sqrt((y%cc(l) - y_th_arr(s))**2._wp + (z%cc(q) - z_th_arr(s))**2._wp) rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth) end do rcut_arr(l, q) = rcut @@ -76,33 +76,33 @@ wl = 2._wp*pi/lam amp = 0.025_wp/wl - intH = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h + intH = amp*(sin(2._wp*pi*x%cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z%cc(k)/lam - pi/2._wp)) + h - alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - intH)/2.5e-3_wp)) + alph = 5.e-1_wp*(1._wp + tanh((y%cc(j) - intH)/2.5e-3_wp)) if (alph < eps) alph = eps if (alph > 1._wp - eps) alph = 1._wp - eps - if (y_cc(j) > intH) then + if (y%cc(j) > intH) then q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoH q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhoL - q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y%cc(j)) else q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoH q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhoL pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(eqn_idx%E)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) + q_prim_vf(eqn_idx%E)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y%cc(j)) end if case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) h = 0.0_wp lam = 1.0_wp amp = patch_icpp(patch_id)%a(2) - intH = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) - if (x_cc(i) > intH) then + intH = amp*abs((sin(2*pi*y%cc(j)/lam - pi/2) + sin(2*pi*z%cc(k)/lam - pi/2)) + h) + if (x%cc(i) > intH) then q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres @@ -122,9 +122,9 @@ eps_smooth = 1._wp eps = 1e-6 - r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp) + r = sqrt((y%cc(j) - y_th)**2._wp + (z%cc(k) - z_th)**2._wp) rcut = f_cut_on(r - r_th, eps_smooth) - xcut = f_cut_on(x_cc(i), eps_smooth) + xcut = f_cut_on(x%cc(i), eps_smooth) q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp @@ -150,7 +150,7 @@ eps = 1e-6 rcut = rcut_arr(j, k) - xcut = f_cut_on(x_cc(i), eps_smooth) + xcut = f_cut_on(x%cc(i), eps_smooth) q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp @@ -174,9 +174,9 @@ Mach = 0.1 if (patch_id == 1) then q_prim_vf(eqn_idx%E)%sf(i, j, & - & k) = 101325 + (Mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2) - q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = Mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -Mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1) + & k) = 101325 + (Mach**2*376.636429464809**2/16)*(cos(2*x%cc(i)/1) + cos(2*y%cc(j)/1))*(cos(2*z%cc(k)/1) + 2) + q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = Mach*376.636429464809*sin(x%cc(i)/1)*cos(y%cc(j)/1)*sin(z%cc(k)/1) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -Mach*376.636429464809*cos(x%cc(i)/1)*sin(y%cc(j)/1)*sin(z%cc(k)/1) end if case default call s_int_to_str(patch_id, iStr) diff --git a/src/common/include/ExtrusionHardcodedIC.fpp b/src/common/include/ExtrusionHardcodedIC.fpp index 762876ecc3..42dd6f8d82 100644 --- a/src/common/include/ExtrusionHardcodedIC.fpp +++ b/src/common/include/ExtrusionHardcodedIC.fpp @@ -97,8 +97,8 @@ ! Calculate offsets domain_xstart = x_coords(1) - x_step = x_cc(1) - x_cc(0) - delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1) + x_step = x%cc(1) - x%cc(0) + delta_x = merge(x%cc(0) - domain_xstart + x_step/2.0, x%cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1) global_offset_x = nint(abs(delta_x)/x_step) case (3) ! 3D case - determine grid structure ! Find yRows by counting rows with same x @@ -156,10 +156,10 @@ end do ! Calculate offsets - x_step = x_cc(1) - x_cc(0) - y_step = y_cc(1) - y_cc(0) - delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp - delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp + x_step = x%cc(1) - x%cc(0) + y_step = y%cc(1) - y%cc(0) + delta_x = x%cc(index_x) - x_coords(1) + x_step/2.0_wp + delta_y = y%cc(index_y) - y_coords(1) + y_step/2.0_wp global_offset_x = nint(abs(delta_x)/x_step) global_offset_y = nint(abs(delta_y)/y_step) end select diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 6eb5383f75..5bb805469a 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -784,7 +784,7 @@ contains integer :: j, q, i do j = 1, buff_size - if (z_cc(l) < pi) then + if (z%cc(l) < pi) then do i = 1, eqn_idx%mom%beg q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l + ((p + 1)/2)) end do @@ -815,7 +815,7 @@ contains do i = 1, nb do q = 1, nnode do j = 1, buff_size - if (z_cc(l) < pi) then + if (z%cc(l) < pi) then pb_in(k, -j, l, q, i) = pb_in(k, j - 1, l + ((p + 1)/2), q, i) mv_in(k, -j, l, q, i) = mv_in(k, j - 1, l + ((p + 1)/2), q, i) else @@ -2166,25 +2166,25 @@ contains call s_mpi_sendrecv_grid_variables_buffers(1, -1) else if (bc_x%beg <= BC_GHOST_EXTRAP) then do i = 1, buff_size - dx(-i) = dx(0) + x%spacing(-i) = x%spacing(0) end do else if (bc_x%beg == BC_REFLECTIVE) then do i = 1, buff_size - dx(-i) = dx(i - 1) + x%spacing(-i) = x%spacing(i - 1) end do else if (bc_x%beg == BC_PERIODIC) then do i = 1, buff_size - dx(-i) = dx(m - (i - 1)) + x%spacing(-i) = x%spacing(m - (i - 1)) end do end if ! Computing the cell-boundary and center locations buffer at bc_x%beg do i = 1, offset_x%beg - x_cb(-1 - i) = x_cb(-i) - dx(-i) + x%cb(-1 - i) = x%cb(-i) - x%spacing(-i) end do do i = 1, buff_size - x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2._wp + x%cc(-i) = x%cc(1 - i) - (x%spacing(1 - i) + x%spacing(-i))/2._wp end do ! Populating the cell-width distribution buffer at bc_x%end @@ -2192,25 +2192,25 @@ contains call s_mpi_sendrecv_grid_variables_buffers(1, 1) else if (bc_x%end <= BC_GHOST_EXTRAP) then do i = 1, buff_size - dx(m + i) = dx(m) + x%spacing(m + i) = x%spacing(m) end do else if (bc_x%end == BC_REFLECTIVE) then do i = 1, buff_size - dx(m + i) = dx(m - (i - 1)) + x%spacing(m + i) = x%spacing(m - (i - 1)) end do else if (bc_x%end == BC_PERIODIC) then do i = 1, buff_size - dx(m + i) = dx(i - 1) + x%spacing(m + i) = x%spacing(i - 1) end do end if ! Populating the cell-boundary and center locations buffer at bc_x%end do i = 1, offset_x%end - x_cb(m + i) = x_cb(m + (i - 1)) + dx(m + i) + x%cb(m + i) = x%cb(m + (i - 1)) + x%spacing(m + i) end do do i = 1, buff_size - x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2._wp + x%cc(m + i) = x%cc(m + (i - 1)) + (x%spacing(m + (i - 1)) + x%spacing(m + i))/2._wp end do ! Population of Buffers in y-direction @@ -2222,25 +2222,25 @@ contains call s_mpi_sendrecv_grid_variables_buffers(2, -1) else if (bc_y%beg <= BC_GHOST_EXTRAP .and. bc_y%beg /= BC_AXIS) then do i = 1, buff_size - dy(-i) = dy(0) + y%spacing(-i) = y%spacing(0) end do else if (bc_y%beg == BC_REFLECTIVE .or. bc_y%beg == BC_AXIS) then do i = 1, buff_size - dy(-i) = dy(i - 1) + y%spacing(-i) = y%spacing(i - 1) end do else if (bc_y%beg == BC_PERIODIC) then do i = 1, buff_size - dy(-i) = dy(n - (i - 1)) + y%spacing(-i) = y%spacing(n - (i - 1)) end do end if ! Computing the cell-boundary and center locations buffer at bc_y%beg do i = 1, offset_y%beg - y_cb(-1 - i) = y_cb(-i) - dy(-i) + y%cb(-1 - i) = y%cb(-i) - y%spacing(-i) end do do i = 1, buff_size - y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2._wp + y%cc(-i) = y%cc(1 - i) - (y%spacing(1 - i) + y%spacing(-i))/2._wp end do ! Populating the cell-width distribution buffer at bc_y%end @@ -2248,25 +2248,25 @@ contains call s_mpi_sendrecv_grid_variables_buffers(2, 1) else if (bc_y%end <= BC_GHOST_EXTRAP) then do i = 1, buff_size - dy(n + i) = dy(n) + y%spacing(n + i) = y%spacing(n) end do else if (bc_y%end == BC_REFLECTIVE) then do i = 1, buff_size - dy(n + i) = dy(n - (i - 1)) + y%spacing(n + i) = y%spacing(n - (i - 1)) end do else if (bc_y%end == BC_PERIODIC) then do i = 1, buff_size - dy(n + i) = dy(i - 1) + y%spacing(n + i) = y%spacing(i - 1) end do end if ! Populating the cell-boundary and center locations buffer at bc_y%end do i = 1, offset_y%end - y_cb(n + i) = y_cb(n + (i - 1)) + dy(n + i) + y%cb(n + i) = y%cb(n + (i - 1)) + y%spacing(n + i) end do do i = 1, buff_size - y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2._wp + y%cc(n + i) = y%cc(n + (i - 1)) + (y%spacing(n + (i - 1)) + y%spacing(n + i))/2._wp end do ! Population of Buffers in z-direction @@ -2278,25 +2278,25 @@ contains call s_mpi_sendrecv_grid_variables_buffers(3, -1) else if (bc_z%beg <= BC_GHOST_EXTRAP) then do i = 1, buff_size - dz(-i) = dz(0) + z%spacing(-i) = z%spacing(0) end do else if (bc_z%beg == BC_REFLECTIVE) then do i = 1, buff_size - dz(-i) = dz(i - 1) + z%spacing(-i) = z%spacing(i - 1) end do else if (bc_z%beg == BC_PERIODIC) then do i = 1, buff_size - dz(-i) = dz(p - (i - 1)) + z%spacing(-i) = z%spacing(p - (i - 1)) end do end if ! Computing the cell-boundary and center locations buffer at bc_z%beg do i = 1, offset_z%beg - z_cb(-1 - i) = z_cb(-i) - dz(-i) + z%cb(-1 - i) = z%cb(-i) - z%spacing(-i) end do do i = 1, buff_size - z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2._wp + z%cc(-i) = z%cc(1 - i) - (z%spacing(1 - i) + z%spacing(-i))/2._wp end do ! Populating the cell-width distribution buffer at bc_z%end @@ -2304,25 +2304,25 @@ contains call s_mpi_sendrecv_grid_variables_buffers(3, 1) else if (bc_z%end <= BC_GHOST_EXTRAP) then do i = 1, buff_size - dz(p + i) = dz(p) + z%spacing(p + i) = z%spacing(p) end do else if (bc_z%end == BC_REFLECTIVE) then do i = 1, buff_size - dz(p + i) = dz(p - (i - 1)) + z%spacing(p + i) = z%spacing(p - (i - 1)) end do else if (bc_z%end == BC_PERIODIC) then do i = 1, buff_size - dz(p + i) = dz(i - 1) + z%spacing(p + i) = z%spacing(i - 1) end do end if ! Populating the cell-boundary and center locations buffer at bc_z%end do i = 1, offset_z%end - z_cb(p + i) = z_cb(p + (i - 1)) + dz(p + i) + z%cb(p + i) = z%cb(p + (i - 1)) + z%spacing(p + i) end do do i = 1, buff_size - z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2._wp + z%cc(p + i) = z%cc(p + (i - 1)) + (z%spacing(p + (i - 1)) + z%spacing(p + i))/2._wp end do #endif diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index 4f35e3e77e..22d817f911 100644 --- a/src/common/m_chemistry.fpp +++ b/src/common/m_chemistry.fpp @@ -56,27 +56,27 @@ contains type(scalar_field), intent(inout) :: q_T_sf type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(int_bounds_info), dimension(1:3), intent(in) :: bounds - integer :: x, y, z, eqn + integer :: cx, cy, cz, eqn real(wp) :: energy, T_in real(wp), dimension(num_species) :: Ys - do z = bounds(3)%beg, bounds(3)%end - do y = bounds(2)%beg, bounds(2)%end - do x = bounds(1)%beg, bounds(1)%end + do cz = bounds(3)%beg, bounds(3)%end + do cy = bounds(2)%beg, bounds(2)%end + do cx = bounds(1)%beg, bounds(1)%end do eqn = eqn_idx%species%beg, eqn_idx%species%end - Ys(eqn - eqn_idx%species%beg + 1) = q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z) + Ys(eqn - eqn_idx%species%beg + 1) = q_cons_vf(eqn)%sf(cx, cy, cz)/q_cons_vf(eqn_idx%cont%beg)%sf(cx, cy, cz) end do ! e = E - 1/2*|u|^2 cons. eqn_idx%E = \rho E cons. eqn_idx%cont%beg = \rho (1-fluid model) cons. eqn_idx%mom%beg ! + i = \rho u_i - energy = q_cons_vf(eqn_idx%E)%sf(x, y, z)/q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z) + energy = q_cons_vf(eqn_idx%E)%sf(cx, cy, cz)/q_cons_vf(eqn_idx%cont%beg)%sf(cx, cy, cz) do eqn = eqn_idx%mom%beg, eqn_idx%mom%end - energy = energy - 0.5_wp*(q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z))**2._wp + energy = energy - 0.5_wp*(q_cons_vf(eqn)%sf(cx, cy, cz)/q_cons_vf(eqn_idx%cont%beg)%sf(cx, cy, cz))**2._wp end do - T_in = real(q_T_sf%sf(x, y, z), kind=wp) + T_in = real(q_T_sf%sf(cx, cy, cz), kind=wp) call get_temperature(energy, dflt_T_guess, Ys, .true., T_in) - q_T_sf%sf(x, y, z) = T_in + q_T_sf%sf(cx, cy, cz) = T_in end do end do end do @@ -89,19 +89,20 @@ contains type(scalar_field), intent(inout) :: q_T_sf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(int_bounds_info), dimension(1:3), intent(in) :: bounds - integer :: x, y, z, i + integer :: cx, cy, cz, i real(wp), dimension(num_species) :: Ys real(wp) :: mix_mol_weight - do z = bounds(3)%beg, bounds(3)%end - do y = bounds(2)%beg, bounds(2)%end - do x = bounds(1)%beg, bounds(1)%end + do cz = bounds(3)%beg, bounds(3)%end + do cy = bounds(2)%beg, bounds(2)%end + do cx = bounds(1)%beg, bounds(1)%end do i = eqn_idx%species%beg, eqn_idx%species%end - Ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(x, y, z) + Ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(cx, cy, cz) end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - q_T_sf%sf(x, y, z) = q_prim_vf(eqn_idx%E)%sf(x, y, z)*mix_mol_weight/(gas_constant*q_prim_vf(1)%sf(x, y, z)) + q_T_sf%sf(cx, cy, cz) = q_prim_vf(eqn_idx%E)%sf(cx, cy, cz)*mix_mol_weight/(gas_constant*q_prim_vf(1)%sf(cx, & + & cy, cz)) end do end do end do @@ -115,7 +116,7 @@ contains type(scalar_field), intent(inout) :: q_T_sf type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_qp, q_prim_qp type(int_bounds_info), dimension(1:3), intent(in) :: bounds - integer :: x, y, z + integer :: cx, cy, cz integer :: eqn real(wp) :: T real(wp) :: rho, omega_m @@ -129,16 +130,16 @@ contains #:endif $:GPU_PARALLEL_LOOP(collapse=3, private='[Ys, omega, eqn, T, rho, omega_m]', copyin='[bounds]') - do z = bounds(3)%beg, bounds(3)%end - do y = bounds(2)%beg, bounds(2)%end - do x = bounds(1)%beg, bounds(1)%end + do cz = bounds(3)%beg, bounds(3)%end + do cy = bounds(2)%beg, bounds(2)%end + do cx = bounds(1)%beg, bounds(1)%end $:GPU_LOOP(parallelism='[seq]') do eqn = eqn_idx%species%beg, eqn_idx%species%end - Ys(eqn - eqn_idx%species%beg + 1) = q_prim_qp(eqn)%sf(x, y, z) + Ys(eqn - eqn_idx%species%beg + 1) = q_prim_qp(eqn)%sf(cx, cy, cz) end do - rho = q_cons_qp(eqn_idx%cont%end)%sf(x, y, z) - T = q_T_sf%sf(x, y, z) + rho = q_cons_qp(eqn_idx%cont%end)%sf(cx, cy, cz) + T = q_T_sf%sf(cx, cy, cz) call get_net_production_rates(rho, T, Ys, omega) @@ -150,7 +151,7 @@ contains #:else omega_m = molecular_weights(eqn - eqn_idx%species%beg + 1)*omega(eqn - eqn_idx%species%beg + 1) #:endif - rhs_vf(eqn)%sf(x, y, z) = rhs_vf(eqn)%sf(x, y, z) + omega_m + rhs_vf(eqn)%sf(cx, cy, cz) = rhs_vf(eqn)%sf(cx, cy, cz) + omega_m end do end do end do @@ -186,7 +187,7 @@ contains real(wp) :: Cp_L, Cp_R real(wp) :: diffusivity_L, diffusivity_R, diffusivity_cell real(wp) :: hmix_L, hmix_R, dh_dxi - integer :: x, y, z, i, n, eqn + integer :: cx, cy, cz, i, n, eqn integer, dimension(3) :: offsets isc1 = irx; isc2 = iry; isc3 = irz @@ -200,29 +201,30 @@ contains ! Model 1: Mixture-Average Transport if (chem_params%transport_model == 1) then ! Note: Added 'i' and 'eqn' to private list. - $:GPU_PARALLEL_LOOP(collapse=3, private='[x, y, z, i, eqn, Ys_L, Ys_R, Ys_cell, Xs_L, Xs_R, & + $:GPU_PARALLEL_LOOP(collapse=3, private='[cx, cy, cz, i, eqn, Ys_L, Ys_R, Ys_cell, Xs_L, Xs_R, & & mass_diffusivities_mixavg1, mass_diffusivities_mixavg2, mass_diffusivities_mixavg_Cell, & & h_l, h_r, Xs_cell, h_k, dXk_dxi, Mass_Diffu_Flux, Mass_Diffu_Energy, MW_L, MW_R, MW_cell, & & T_L, T_R, P_L, P_R, rho_L, rho_R, rho_cell, rho_Vic, lambda_L, lambda_R, lambda_Cell, & & dT_dxi, grid_spacing]', copyin='[offsets]') - do z = isc3%beg, isc3%end - do y = isc2%beg, isc2%end - do x = isc1%beg, isc1%end + do cz = isc3%beg, isc3%end + do cy = isc2%beg, isc2%end + do cx = isc1%beg, isc1%end ! Calculate grid spacing using direction-based indexing select case (idir) case (1) - grid_spacing = x_cc(x + 1) - x_cc(x) + grid_spacing = x%cc(cx + 1) - x%cc(cx) case (2) - grid_spacing = y_cc(y + 1) - y_cc(y) + grid_spacing = y%cc(cy + 1) - y%cc(cy) case (3) - grid_spacing = z_cc(z + 1) - z_cc(z) + grid_spacing = z%cc(cz + 1) - z%cc(cz) end select ! Extract species mass fractions $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%species%beg, eqn_idx%species%end - Ys_L(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x, y, z) - Ys_R(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + Ys_L(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(cx, cy, cz) + Ys_R(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(cx + offsets(1), cy + offsets(2), & + & cz + offsets(3)) Ys_cell(i - eqn_idx%species%beg + 1) = 0.5_wp*(Ys_L(i - eqn_idx%species%beg + 1) + Ys_R(i & & - eqn_idx%species%beg + 1)) end do @@ -235,14 +237,14 @@ contains call get_mole_fractions(MW_L, Ys_L, Xs_L) call get_mole_fractions(MW_R, Ys_R, Xs_R) - P_L = q_prim_qp(eqn_idx%E)%sf(x, y, z) - P_R = q_prim_qp(eqn_idx%E)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + P_L = q_prim_qp(eqn_idx%E)%sf(cx, cy, cz) + P_R = q_prim_qp(eqn_idx%E)%sf(cx + offsets(1), cy + offsets(2), cz + offsets(3)) - rho_L = q_prim_qp(1)%sf(x, y, z) - rho_R = q_prim_qp(1)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + rho_L = q_prim_qp(1)%sf(cx, cy, cz) + rho_R = q_prim_qp(1)%sf(cx + offsets(1), cy + offsets(2), cz + offsets(3)) - T_L = q_T_sf%sf(x, y, z) - T_R = q_T_sf%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + T_L = q_T_sf%sf(cx, cy, cz) + T_R = q_T_sf%sf(cx + offsets(1), cy + offsets(2), cz + offsets(3)) rho_cell = 0.5_wp*(rho_L + rho_R) dT_dxi = (T_R - T_L)/grid_spacing @@ -322,12 +324,12 @@ contains Mass_Diffu_Energy = lambda_Cell*dT_dxi + Mass_Diffu_Energy ! Update flux arrays - flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy + flux_src_vf(eqn_idx%E)%sf(cx, cy, cz) = flux_src_vf(eqn_idx%E)%sf(cx, cy, cz) - Mass_Diffu_Energy $:GPU_LOOP(parallelism='[seq]') do eqn = eqn_idx%species%beg, eqn_idx%species%end - flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, & - & z) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) + flux_src_vf(eqn)%sf(cx, cy, cz) = flux_src_vf(eqn)%sf(cx, cy, & + & cz) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) end do end do end do @@ -337,28 +339,29 @@ contains ! Model 2: Unity Lewis Number else if (chem_params%transport_model == 2) then ! Note: Added ALL scalars and 'i'/'eqn' to private list to prevent race conditions. - $:GPU_PARALLEL_LOOP(collapse=3, private='[x, y, z, i, eqn, Ys_L, Ys_R, Ys_cell, dYk_dxi, Mass_Diffu_Flux, & + $:GPU_PARALLEL_LOOP(collapse=3, private='[cx, cy, cz, i, eqn, Ys_L, Ys_R, Ys_cell, dYk_dxi, Mass_Diffu_Flux, & & grid_spacing, MW_L, MW_R, MW_cell, P_L, P_R, rho_L, rho_R, rho_cell, T_L, T_R, Cp_L, Cp_R, & & hmix_L, hmix_R, dh_dxi, lambda_L, lambda_R, lambda_Cell, diffusivity_L, diffusivity_R, & & diffusivity_cell, Mass_Diffu_Energy]', copyin='[offsets]') - do z = isc3%beg, isc3%end - do y = isc2%beg, isc2%end - do x = isc1%beg, isc1%end + do cz = isc3%beg, isc3%end + do cy = isc2%beg, isc2%end + do cx = isc1%beg, isc1%end ! Calculate grid spacing using direction-based indexing select case (idir) case (1) - grid_spacing = x_cc(x + 1) - x_cc(x) + grid_spacing = x%cc(cx + 1) - x%cc(cx) case (2) - grid_spacing = y_cc(y + 1) - y_cc(y) + grid_spacing = y%cc(cy + 1) - y%cc(cy) case (3) - grid_spacing = z_cc(z + 1) - z_cc(z) + grid_spacing = z%cc(cz + 1) - z%cc(cz) end select ! Extract species mass fractions $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%species%beg, eqn_idx%species%end - Ys_L(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x, y, z) - Ys_R(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + Ys_L(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(cx, cy, cz) + Ys_R(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(cx + offsets(1), cy + offsets(2), & + & cz + offsets(3)) Ys_cell(i - eqn_idx%species%beg + 1) = 0.5_wp*(Ys_L(i - eqn_idx%species%beg + 1) + Ys_R(i & & - eqn_idx%species%beg + 1)) end do @@ -368,14 +371,14 @@ contains call get_mixture_molecular_weight(Ys_R, MW_R) MW_cell = 0.5_wp*(MW_L + MW_R) - P_L = q_prim_qp(eqn_idx%E)%sf(x, y, z) - P_R = q_prim_qp(eqn_idx%E)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + P_L = q_prim_qp(eqn_idx%E)%sf(cx, cy, cz) + P_R = q_prim_qp(eqn_idx%E)%sf(cx + offsets(1), cy + offsets(2), cz + offsets(3)) - rho_L = q_prim_qp(1)%sf(x, y, z) - rho_R = q_prim_qp(1)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + rho_L = q_prim_qp(1)%sf(cx, cy, cz) + rho_R = q_prim_qp(1)%sf(cx + offsets(1), cy + offsets(2), cz + offsets(3)) - T_L = q_T_sf%sf(x, y, z) - T_R = q_T_sf%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + T_L = q_T_sf%sf(cx, cy, cz) + T_R = q_T_sf%sf(cx + offsets(1), cy + offsets(2), cz + offsets(3)) rho_cell = 0.5_wp*(rho_L + rho_R) @@ -414,12 +417,12 @@ contains Mass_Diffu_Energy = rho_cell*diffusivity_cell*dh_dxi ! Update flux arrays - flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy + flux_src_vf(eqn_idx%E)%sf(cx, cy, cz) = flux_src_vf(eqn_idx%E)%sf(cx, cy, cz) - Mass_Diffu_Energy $:GPU_LOOP(parallelism='[seq]') do eqn = eqn_idx%species%beg, eqn_idx%species%end - flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, & - & z) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) + flux_src_vf(eqn)%sf(cx, cy, cz) = flux_src_vf(eqn)%sf(cx, cy, & + & cz) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) end do end do end do diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 6ee2e836a5..489dfd2c06 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -13,6 +13,11 @@ module m_derived_types implicit none + !> Derived type for a single spatial grid axis: cell-boundary, cell-center, and per-cell spacing arrays + type grid_axis + real(wp), allocatable, dimension(:) :: cb, cc, spacing + end type grid_axis + !> Derived type adding the field position (fp) as an attribute type field_position real(stp), allocatable, dimension(:,:,:) :: fp !< Field position @@ -170,6 +175,12 @@ module m_derived_types real(wp) :: end end type bounds_info + !> Derived type grouping body force parameters for one coordinate direction + type body_force_axis + real(wp) :: k, w, p, g + logical :: enabled + end type body_force_axis + !> Defines parameters for a Model Patch type ic_model_parameters character(LEN=pathlen_max) :: filepath !< Path the STL file relative to case_dir. diff --git a/src/common/m_model.fpp b/src/common/m_model.fpp index 0dab036f9b..88ce8f8237 100644 --- a/src/common/m_model.fpp +++ b/src/common/m_model.fpp @@ -980,8 +980,8 @@ contains real(wp) :: grid_mm(1:3,1:2) real(wp), dimension(1:4,1:4) :: transform, transform_n - dx_local = minval(dx); dy_local = minval(dy) - if (p /= 0) dz_local = minval(dz) + dx_local = minval(x%spacing); dy_local = minval(y%spacing) + if (p /= 0) dz_local = minval(z%spacing) allocate (stl_bounding_boxes(num_ibs,1:3,1:3)) @@ -1036,11 +1036,11 @@ contains write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3) - grid_mm(1,:) = (/minval(x_cc(0:m)) - 0.5_wp*dx_local, maxval(x_cc(0:m)) + 0.5_wp*dx_local/) - grid_mm(2,:) = (/minval(y_cc(0:n)) - 0.5_wp*dy_local, maxval(y_cc(0:n)) + 0.5_wp*dy_local/) + grid_mm(1,:) = (/minval(x%cc(0:m)) - 0.5_wp*dx_local, maxval(x%cc(0:m)) + 0.5_wp*dx_local/) + grid_mm(2,:) = (/minval(y%cc(0:n)) - 0.5_wp*dy_local, maxval(y%cc(0:n)) + 0.5_wp*dy_local/) if (p > 0) then - grid_mm(3,:) = (/minval(z_cc(0:p)) - 0.5_wp*dz_local, maxval(z_cc(0:p)) + 0.5_wp*dz_local/) + grid_mm(3,:) = (/minval(z%cc(0:p)) - 0.5_wp*dz_local, maxval(z%cc(0:p)) + 0.5_wp*dz_local/) else grid_mm(3,:) = (/0._wp, 0._wp/) end if diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 7d4b92705c..b2d6465243 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -1443,57 +1443,57 @@ contains if (pbc_loc == -1) then ! PBC at the beginning if (bc_x%end >= 0) then ! PBC at the beginning and end - call MPI_SENDRECV(dx(m - buff_size + 1), buff_size, mpi_p, bc_x%end, 0, dx(-buff_size), buff_size, mpi_p, & - & bc_x%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(x%spacing(m - buff_size + 1), buff_size, mpi_p, bc_x%end, 0, x%spacing(-buff_size), & + & buff_size, mpi_p, bc_x%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the beginning only - call MPI_SENDRECV(dx(0), buff_size, mpi_p, bc_x%beg, 1, dx(-buff_size), buff_size, mpi_p, bc_x%beg, 0, & - & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(x%spacing(0), buff_size, mpi_p, bc_x%beg, 1, x%spacing(-buff_size), buff_size, mpi_p, & + & bc_x%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if else ! PBC at the end if (bc_x%beg >= 0) then ! PBC at the end and beginning - call MPI_SENDRECV(dx(0), buff_size, mpi_p, bc_x%beg, 1, dx(m + 1), buff_size, mpi_p, bc_x%end, 1, & - & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(x%spacing(0), buff_size, mpi_p, bc_x%beg, 1, x%spacing(m + 1), buff_size, mpi_p, bc_x%end, & + & 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the end only - call MPI_SENDRECV(dx(m - buff_size + 1), buff_size, mpi_p, bc_x%end, 0, dx(m + 1), buff_size, mpi_p, & - & bc_x%end, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(x%spacing(m - buff_size + 1), buff_size, mpi_p, bc_x%end, 0, x%spacing(m + 1), buff_size, & + & mpi_p, bc_x%end, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if end if else if (mpi_dir == 2) then if (pbc_loc == -1) then ! PBC at the beginning if (bc_y%end >= 0) then ! PBC at the beginning and end - call MPI_SENDRECV(dy(n - buff_size + 1), buff_size, mpi_p, bc_y%end, 0, dy(-buff_size), buff_size, mpi_p, & - & bc_y%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(y%spacing(n - buff_size + 1), buff_size, mpi_p, bc_y%end, 0, y%spacing(-buff_size), & + & buff_size, mpi_p, bc_y%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the beginning only - call MPI_SENDRECV(dy(0), buff_size, mpi_p, bc_y%beg, 1, dy(-buff_size), buff_size, mpi_p, bc_y%beg, 0, & - & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(y%spacing(0), buff_size, mpi_p, bc_y%beg, 1, y%spacing(-buff_size), buff_size, mpi_p, & + & bc_y%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if else ! PBC at the end if (bc_y%beg >= 0) then ! PBC at the end and beginning - call MPI_SENDRECV(dy(0), buff_size, mpi_p, bc_y%beg, 1, dy(n + 1), buff_size, mpi_p, bc_y%end, 1, & - & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(y%spacing(0), buff_size, mpi_p, bc_y%beg, 1, y%spacing(n + 1), buff_size, mpi_p, bc_y%end, & + & 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the end only - call MPI_SENDRECV(dy(n - buff_size + 1), buff_size, mpi_p, bc_y%end, 0, dy(n + 1), buff_size, mpi_p, & - & bc_y%end, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(y%spacing(n - buff_size + 1), buff_size, mpi_p, bc_y%end, 0, y%spacing(n + 1), buff_size, & + & mpi_p, bc_y%end, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if end if else if (pbc_loc == -1) then ! PBC at the beginning if (bc_z%end >= 0) then ! PBC at the beginning and end - call MPI_SENDRECV(dz(p - buff_size + 1), buff_size, mpi_p, bc_z%end, 0, dz(-buff_size), buff_size, mpi_p, & - & bc_z%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(z%spacing(p - buff_size + 1), buff_size, mpi_p, bc_z%end, 0, z%spacing(-buff_size), & + & buff_size, mpi_p, bc_z%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the beginning only - call MPI_SENDRECV(dz(0), buff_size, mpi_p, bc_z%beg, 1, dz(-buff_size), buff_size, mpi_p, bc_z%beg, 0, & - & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(z%spacing(0), buff_size, mpi_p, bc_z%beg, 1, z%spacing(-buff_size), buff_size, mpi_p, & + & bc_z%beg, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if else ! PBC at the end if (bc_z%beg >= 0) then ! PBC at the end and beginning - call MPI_SENDRECV(dz(0), buff_size, mpi_p, bc_z%beg, 1, dz(p + 1), buff_size, mpi_p, bc_z%end, 1, & - & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(z%spacing(0), buff_size, mpi_p, bc_z%beg, 1, z%spacing(p + 1), buff_size, mpi_p, bc_z%end, & + & 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the end only - call MPI_SENDRECV(dz(p - buff_size + 1), buff_size, mpi_p, bc_z%end, 0, dz(p + 1), buff_size, mpi_p, & - & bc_z%end, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) + call MPI_SENDRECV(z%spacing(p - buff_size + 1), buff_size, mpi_p, bc_z%end, 0, z%spacing(p + 1), buff_size, & + & mpi_p, bc_z%end, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if end if end if diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 287a8a505c..f6bee854f6 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -215,13 +215,13 @@ impure subroutine s_read_serial_data_files(t_step) ! actual arrays. Without slicing, when offset_x%beg or buff_size > 0 (i.e. format=1 parallel 3D ranks), Fortran's ! assumed-shape re-mapping shifts the read by that many slots and leaves the last interior cells uninitialized - corrupting ! downstream ghost-cell extrapolation. - call s_read_grid_data_direction(t_step_dir, 'x', x_cb(-1:m), dx(0:m), x_cc(0:m), m) + call s_read_grid_data_direction(t_step_dir, 'x', x%cb(-1:m), x%spacing(0:m), x%cc(0:m), m) if (n > 0) then - call s_read_grid_data_direction(t_step_dir, 'y', y_cb(-1:n), dy(0:n), y_cc(0:n), n) + call s_read_grid_data_direction(t_step_dir, 'y', y%cb(-1:n), y%spacing(0:n), y%cc(0:n), n) if (p > 0) then - call s_read_grid_data_direction(t_step_dir, 'z', z_cb(-1:p), dz(0:p), z_cc(0:p), p) + call s_read_grid_data_direction(t_step_dir, 'z', z%cb(-1:p), z%spacing(0:p), z%cc(0:p), p) end if end if @@ -296,9 +296,9 @@ impure subroutine s_read_parallel_data_files(t_step) call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.') end if - x_cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) - dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp + x%cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) + x%spacing(0:m) = x%cb(0:m) - x%cb(-1:m - 1) + x%cc(0:m) = x%cb(-1:m - 1) + x%spacing(0:m)/2._wp if (n > 0) then file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'y_cb.dat' @@ -320,9 +320,9 @@ impure subroutine s_read_parallel_data_files(t_step) call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.') end if - y_cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) - dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp + y%cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) + y%spacing(0:n) = y%cb(0:n) - y%cb(-1:n - 1) + y%cc(0:n) = y%cb(-1:n - 1) + y%spacing(0:n)/2._wp if (p > 0) then file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'z_cb.dat' @@ -344,9 +344,9 @@ impure subroutine s_read_parallel_data_files(t_step) call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.') end if - z_cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) - dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp + z%cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) + z%spacing(0:p) = z%cb(0:p) - z%cb(-1:p - 1) + z%cc(0:p) = z%cb(-1:p - 1) + z%spacing(0:p)/2._wp end if end if diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index aece31ff8d..79e7427330 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -326,21 +326,21 @@ contains upper_bound = ${M}$ + offset_${X}$%end do i = lower_bound, upper_bound - if (${X}$_cc(i) > ${X}$_output%beg) then + if (${X}$%cc(i) > ${X}$_output%beg) then ${X}$_output_idx%beg = i + offset_${X}$%beg exit end if end do do i = upper_bound, lower_bound, -1 - if (${X}$_cc(i) < ${X}$_output%end) then + if (${X}$%cc(i) < ${X}$_output%end) then ${X}$_output_idx%end = i + offset_${X}$%beg exit end if end do ! If no grid points are within the output region - if ((${X}$_cc(lower_bound) > ${X}$_output%end) .or. (${X}$_cc(upper_bound) < ${X}$_output%beg)) then + if ((${X}$%cc(lower_bound) > ${X}$_output%end) .or. (${X}$%cc(upper_bound) < ${X}$_output%beg)) then ${X}$_output_idx%beg = 0 ${X}$_output_idx%end = 0 end if @@ -455,14 +455,14 @@ contains call s_mpi_gather_spatial_extents(spatial_extents) else if (p > 0) then if (grid_geometry == 3) then - spatial_extents(:,0) = (/minval(y_cb), minval(z_cb), minval(x_cb), maxval(y_cb), maxval(z_cb), maxval(x_cb)/) + spatial_extents(:,0) = (/minval(y%cb), minval(z%cb), minval(x%cb), maxval(y%cb), maxval(z%cb), maxval(x%cb)/) else - spatial_extents(:,0) = (/minval(x_cb), minval(y_cb), minval(z_cb), maxval(x_cb), maxval(y_cb), maxval(z_cb)/) + spatial_extents(:,0) = (/minval(x%cb), minval(y%cb), minval(z%cb), maxval(x%cb), maxval(y%cb), maxval(z%cb)/) end if else if (n > 0) then - spatial_extents(:,0) = (/minval(x_cb), minval(y_cb), maxval(x_cb), maxval(y_cb)/) + spatial_extents(:,0) = (/minval(x%cb), minval(y%cb), maxval(x%cb), maxval(y%cb)/) else - spatial_extents(:,0) = (/minval(x_cb), maxval(x_cb)/) + spatial_extents(:,0) = (/minval(x%cb), maxval(x%cb)/) end if ! Next, the root processor proceeds to record all of the spatial extents in the formatted database master file. In @@ -492,10 +492,10 @@ contains err = DBADDIAOPT(optlist, DBOPT_LO_OFFSET, size(lo_offset), lo_offset) err = DBADDIAOPT(optlist, DBOPT_HI_OFFSET, size(hi_offset), hi_offset) if (grid_geometry == 3) then - err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, y_cb, z_cb, x_cb, dims, 3, DB_DOUBLE, & + err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, y%cb, z%cb, x%cb, dims, 3, DB_DOUBLE, & & DB_COLLINEAR, optlist, ierr) else - err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x_cb, y_cb, z_cb, dims, 3, DB_DOUBLE, & + err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x%cb, y%cb, z%cb, dims, 3, DB_DOUBLE, & & DB_COLLINEAR, optlist, ierr) end if err = DBFREEOPTLIST(optlist) @@ -503,14 +503,14 @@ contains err = DBMKOPTLIST(2, optlist) err = DBADDIAOPT(optlist, DBOPT_LO_OFFSET, size(lo_offset), lo_offset) err = DBADDIAOPT(optlist, DBOPT_HI_OFFSET, size(hi_offset), hi_offset) - err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x_cb, y_cb, DB_F77NULL, dims, 2, DB_DOUBLE, & + err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x%cb, y%cb, DB_F77NULL, dims, 2, DB_DOUBLE, & & DB_COLLINEAR, optlist, ierr) err = DBFREEOPTLIST(optlist) else err = DBMKOPTLIST(2, optlist) err = DBADDIAOPT(optlist, DBOPT_LO_OFFSET, size(lo_offset), lo_offset) err = DBADDIAOPT(optlist, DBOPT_HI_OFFSET, size(hi_offset), hi_offset) - err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x_cb, DB_F77NULL, DB_F77NULL, dims, 1, & + err = DBPUTQM(dbfile, 'rectilinear_grid', 16, 'x', 1, 'y', 1, 'z', 1, x%cb, DB_F77NULL, DB_F77NULL, dims, 1, & & DB_DOUBLE, DB_COLLINEAR, optlist, ierr) err = DBFREEOPTLIST(optlist) end if @@ -519,23 +519,23 @@ contains ! maintained in multidimensions. if (p > 0) then if (precision == 1) then - write (dbfile) real(x_cb, sp), real(y_cb, sp), real(z_cb, sp) + write (dbfile) real(x%cb, sp), real(y%cb, sp), real(z%cb, sp) else if (output_partial_domain) then - write (dbfile) x_cb(x_output_idx%beg - 1:x_output_idx%end), y_cb(y_output_idx%beg - 1:y_output_idx%end), & - & z_cb(z_output_idx%beg - 1:z_output_idx%end) + write (dbfile) x%cb(x_output_idx%beg - 1:x_output_idx%end), y%cb(y_output_idx%beg - 1:y_output_idx%end), & + & z%cb(z_output_idx%beg - 1:z_output_idx%end) else - write (dbfile) x_cb, y_cb, z_cb + write (dbfile) x%cb, y%cb, z%cb end if end if else if (n > 0) then if (precision == 1) then - write (dbfile) real(x_cb, sp), real(y_cb, sp) + write (dbfile) real(x%cb, sp), real(y%cb, sp) else if (output_partial_domain) then - write (dbfile) x_cb(x_output_idx%beg - 1:x_output_idx%end), y_cb(y_output_idx%beg - 1:y_output_idx%end) + write (dbfile) x%cb(x_output_idx%beg - 1:x_output_idx%end), y%cb(y_output_idx%beg - 1:y_output_idx%end) else - write (dbfile) x_cb, y_cb + write (dbfile) x%cb, y%cb end if end if @@ -543,19 +543,19 @@ contains ! is put together by the root process and written to the master file. else if (precision == 1) then - write (dbfile) real(x_cb, sp) + write (dbfile) real(x%cb, sp) else if (output_partial_domain) then - write (dbfile) x_cb(x_output_idx%beg - 1:x_output_idx%end) + write (dbfile) x%cb(x_output_idx%beg - 1:x_output_idx%end) else - write (dbfile) x_cb + write (dbfile) x%cb end if end if if (num_procs > 1) then call s_mpi_defragment_1d_grid_variable() else - x_root_cb(:) = x_cb(:) + x_root_cb(:) = x%cb(:) end if if (proc_rank == 0) then @@ -1189,7 +1189,7 @@ contains call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) if (p > 0) then do l = 0, p - if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then + if (z%cc(l) < z%spacing(l) .and. z%cc(l) > 0) then cent = l end if end do @@ -1208,18 +1208,18 @@ contains & .or. (ayp < thres .and. aym > thres)) then if (counter == 0) then counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) + x_d1(counter) = x%cc(j) + y_d1(counter) = y%cc(k) else - tgp = sqrt(dx(j)**2 + dy(k)**2) + tgp = sqrt(x%spacing(j)**2 + y%spacing(k)**2) do i = 1, counter - euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) + euc_d = sqrt((x%cc(j) - x_d1(i))**2 + (y%cc(k) - y_d1(i))**2) if (euc_d < tgp) then exit else if (i == counter) then counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) + x_d1(counter) = x%cc(j) + y_d1(counter) = y%cc(k) end if end do end if @@ -1278,7 +1278,7 @@ contains do j = 0, n do i = 0, m pres = 0._wp - dV = dx(i)*dy(j)*dz(k) + dV = x%spacing(i)*y%spacing(j)*z%spacing(k) rho = 0._wp gamma = 0._wp pi_inf = 0._wp diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 9676e44396..a22c7bbdfc 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -218,8 +218,8 @@ contains do r = -fd_number, fd_number if (grid_geometry == 3) then - q_sf(j, k, l) = q_sf(j, k, l) + 1._wp/y_cc(k)*(fd_coeff_y(r, & - & k)*y_cc(r + k)*q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, l) - fd_coeff_z(r, & + q_sf(j, k, l) = q_sf(j, k, l) + 1._wp/y%cc(k)*(fd_coeff_y(r, & + & k)*y%cc(r + k)*q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, l) - fd_coeff_z(r, & & l)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, r + l)) else q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_y(r, k)*q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, & @@ -237,7 +237,7 @@ contains do r = -fd_number, fd_number if (grid_geometry == 3) then - q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)/y_cc(k)*q_prim_vf(eqn_idx%mom%beg)%sf(j, k, & + q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)/y%cc(k)*q_prim_vf(eqn_idx%mom%beg)%sf(j, k, & & r + l) - fd_coeff_x(r, j)*q_prim_vf(eqn_idx%mom%end)%sf(r + j, k, l) else q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)*q_prim_vf(eqn_idx%mom%beg)%sf(j, k, & @@ -284,13 +284,13 @@ contains do r = -fd_number, fd_number do jj = 1, 3 - ! d()/dx + ! d()/x%spacing q_jacobian_sf(jj, 1) = q_jacobian_sf(jj, 1) + fd_coeff_x(r, & & j)*q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(r + j, k, l) - ! d()/dy + ! d()/y%spacing q_jacobian_sf(jj, 2) = q_jacobian_sf(jj, 2) + fd_coeff_y(r, & & k)*q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(j, r + k, l) - ! d()/dz + ! d()/z%spacing q_jacobian_sf(jj, 3) = q_jacobian_sf(jj, 3) + fd_coeff_z(r, & & l)*q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(j, k, r + l) end do @@ -362,11 +362,11 @@ contains do r = -fd_number, fd_number do i = 1, 3 - ! d()/dx + ! d()/x%spacing vgt(i, 1) = vgt(i, 1) + fd_coeff_x(r, j)*q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(r + j, k, l) - ! d()/dy + ! d()/y%spacing vgt(i, 2) = vgt(i, 2) + fd_coeff_y(r, k)*q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, r + k, l) - ! d()/dz + ! d()/z%spacing vgt(i, 3) = vgt(i, 3) + fd_coeff_z(r, l)*q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, r + l) end do end do @@ -464,7 +464,7 @@ contains do i = -fd_number, fd_number if (grid_geometry == 3) then - drho_dz = drho_dz + fd_coeff_z(i, l)/y_cc(k)*rho_sf(j, k, i + l) + drho_dz = drho_dz + fd_coeff_z(i, l)/y%cc(k)*rho_sf(j, k, i + l) else drho_dz = drho_dz + fd_coeff_z(i, l)*rho_sf(j, k, i + l) end if diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 122fb73a86..1e19b61598 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -50,22 +50,13 @@ module m_global_parameters integer :: num_dims !< Number of spatial dimensions integer :: num_vels !< Number of velocity components (different from num_dims for mhd) - !> @name Cell-boundary locations in the x-, y- and z-coordinate directions + !> @name Cell-boundary (cb), cell-center (cc), and spacing arrays per direction !> @{ - real(wp), allocatable, dimension(:) :: x_cb, x_root_cb, y_cb, z_cb - !> @} - - !> @name Cell-center locations in the x-, y- and z-coordinate directions - !> @{ - real(wp), allocatable, dimension(:) :: x_cc, x_root_cc, y_cc, z_cc + type(grid_axis) :: x, y, z + real(wp), allocatable, dimension(:) :: x_root_cb, x_root_cc real(sp), allocatable, dimension(:) :: x_root_cc_s, x_cc_s !> @} - !> Cell-width distributions in the x-, y- and z-coordinate directions - !> @{ - real(wp), allocatable, dimension(:) :: dx, dy, dz - !> @} - integer :: buff_size !< Number of ghost cells for boundary condition storage integer :: t_step_start !< First time-step directory integer :: t_step_stop !< Last time-step directory @@ -819,20 +810,20 @@ contains allocate (x_cc_s(-buff_size:m + buff_size)) ! Allocating the grid variables in the x-coordinate direction - allocate (x_cb(-1 - offset_x%beg:m + offset_x%end)) - allocate (x_cc(-buff_size:m + buff_size)) - allocate (dx(-buff_size:m + buff_size)) + allocate (x%cb(-1 - offset_x%beg:m + offset_x%end)) + allocate (x%cc(-buff_size:m + buff_size)) + allocate (x%spacing(-buff_size:m + buff_size)) ! Allocating grid variables in the y- and z-coordinate directions if (n > 0) then - allocate (y_cb(-1 - offset_y%beg:n + offset_y%end)) - allocate (y_cc(-buff_size:n + buff_size)) - allocate (dy(-buff_size:n + buff_size)) + allocate (y%cb(-1 - offset_y%beg:n + offset_y%end)) + allocate (y%cc(-buff_size:n + buff_size)) + allocate (y%spacing(-buff_size:n + buff_size)) if (p > 0) then - allocate (z_cb(-1 - offset_z%beg:p + offset_z%end)) - allocate (z_cc(-buff_size:p + buff_size)) - allocate (dz(-buff_size:p + buff_size)) + allocate (z%cb(-1 - offset_z%beg:p + offset_z%end)) + allocate (z%cc(-buff_size:p + buff_size)) + allocate (z%spacing(-buff_size:p + buff_size)) end if ! Allocating the grid variables, only used for the 1D simulations, and containing the defragmented computational domain @@ -904,13 +895,13 @@ contains ! Deallocating the grid variables for the x-coordinate direction - deallocate (x_cc, x_cb, dx) + deallocate (x%cc, x%cb, x%spacing) ! Deallocating grid variables for the y- and z-coordinate directions if (n > 0) then - deallocate (y_cc, y_cb, dy) + deallocate (y%cc, y%cb, y%spacing) if (p > 0) then - deallocate (z_cc, z_cb, dz) + deallocate (z%cc, z%cb, z%spacing) end if else ! Deallocating the grid variables, only used for the 1D simulations, and containing the defragmented computational diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index b9288d58b0..ab32967cc2 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -156,77 +156,77 @@ contains if (p > 0) then if (grid_geometry == 3) then ! Minimum spatial extent in the r-direction - call MPI_GATHERV(minval(y_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(minval(y%cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Minimum spatial extent in the theta-direction - call MPI_GATHERV(minval(z_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(minval(z%cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Minimum spatial extent in the z-direction - call MPI_GATHERV(minval(x_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(minval(x%cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Maximum spatial extent in the r-direction - call MPI_GATHERV(maxval(y_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(maxval(y%cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Maximum spatial extent in the theta-direction - call MPI_GATHERV(maxval(z_cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(maxval(z%cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Maximum spatial extent in the z-direction - call MPI_GATHERV(maxval(x_cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(maxval(x%cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) else ! Minimum spatial extent in the x-direction - call MPI_GATHERV(minval(x_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(minval(x%cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Minimum spatial extent in the y-direction - call MPI_GATHERV(minval(y_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(minval(y%cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Minimum spatial extent in the z-direction - call MPI_GATHERV(minval(z_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(minval(z%cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Maximum spatial extent in the x-direction - call MPI_GATHERV(maxval(x_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(maxval(x%cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Maximum spatial extent in the y-direction - call MPI_GATHERV(maxval(y_cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(maxval(y%cb), 1, mpi_p, spatial_extents(5, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) ! Maximum spatial extent in the z-direction - call MPI_GATHERV(maxval(z_cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & + call MPI_GATHERV(maxval(z%cb), 1, mpi_p, spatial_extents(6, 0), recvcounts, 6*displs, mpi_p, 0, MPI_COMM_WORLD, & & ierr) end if ! Simulation is 2D else if (n > 0) then ! Minimum spatial extent in the x-direction - call MPI_GATHERV(minval(x_cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHERV(minval(x%cb), 1, mpi_p, spatial_extents(1, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) ! Minimum spatial extent in the y-direction - call MPI_GATHERV(minval(y_cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHERV(minval(y%cb), 1, mpi_p, spatial_extents(2, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) ! Maximum spatial extent in the x-direction - call MPI_GATHERV(maxval(x_cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHERV(maxval(x%cb), 1, mpi_p, spatial_extents(3, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) ! Maximum spatial extent in the y-direction - call MPI_GATHERV(maxval(y_cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHERV(maxval(y%cb), 1, mpi_p, spatial_extents(4, 0), recvcounts, 4*displs, mpi_p, 0, MPI_COMM_WORLD, ierr) ! Simulation is 1D else ! For 1D, recvcounts/displs are sized for grid defragmentation (m+1 per rank), not for scalar gathers. Use MPI_GATHER ! instead. ! Minimum spatial extent in the x-direction - call MPI_GATHER(minval(x_cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHER(minval(x%cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) if (proc_rank == 0) spatial_extents(1,:) = ext_temp ! Maximum spatial extent in the x-direction - call MPI_GATHER(maxval(x_cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHER(maxval(x%cb), 1, mpi_p, ext_temp, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) if (proc_rank == 0) spatial_extents(2,:) = ext_temp end if #endif @@ -242,13 +242,13 @@ contains ! Silo-HDF5 database format if (format == 1) then - call MPI_GATHERV(x_cc(0), m + 1, mpi_p, x_root_cc(0), recvcounts, displs, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHERV(x%cc(0), m + 1, mpi_p, x_root_cc(0), recvcounts, displs, mpi_p, 0, MPI_COMM_WORLD, ierr) ! Binary database format else - call MPI_GATHERV(x_cb(0), m + 1, mpi_p, x_root_cb(0), recvcounts, displs, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHERV(x%cb(0), m + 1, mpi_p, x_root_cb(0), recvcounts, displs, mpi_p, 0, MPI_COMM_WORLD, ierr) - if (proc_rank == 0) x_root_cb(-1) = x_cb(-1) + if (proc_rank == 0) x_root_cb(-1) = x%cb(-1) end if #endif diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index ce51702f93..8f18e621c0 100644 --- a/src/post_process/m_start_up.fpp +++ b/src/post_process/m_start_up.fpp @@ -224,15 +224,15 @@ contains call s_write_grid_to_formatted_database_file(t_step) if (omega_wrt(2) .or. omega_wrt(3) .or. qm_wrt .or. liutex_wrt .or. schlieren_wrt) then - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, fd_number, fd_order, offset_x) + call s_compute_finite_difference_coefficients(m, x%cc, fd_coeff_x, buff_size, fd_number, fd_order, offset_x) end if if (omega_wrt(1) .or. omega_wrt(3) .or. qm_wrt .or. liutex_wrt .or. (n > 0 .and. schlieren_wrt)) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, fd_number, fd_order, offset_y) + call s_compute_finite_difference_coefficients(n, y%cc, fd_coeff_y, buff_size, fd_number, fd_order, offset_y) end if if (omega_wrt(1) .or. omega_wrt(2) .or. qm_wrt .or. liutex_wrt .or. (p > 0 .and. schlieren_wrt)) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, fd_number, fd_order, offset_z) + call s_compute_finite_difference_coefficients(p, z%cc, fd_coeff_z, buff_size, fd_number, fd_order, offset_z) end if if ((model_eqns == 2) .or. (model_eqns == 3) .or. (model_eqns == 4)) then diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 5e250310b7..1622a92890 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -97,15 +97,15 @@ contains do i = 1, eqn_idx%E - eqn_idx%mom%beg q_prim_vf(i + 1)%sf(j, k, l) = 1._wp/q_prim_vf(1)%sf(j, k, & - & l)*(eta*patch_icpp(patch_id)%rho*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*patch_icpp(smooth_patch_id) & - & %rho*patch_icpp(smooth_patch_id)%vel(i)) + & l)*(eta*patch_icpp(patch_id)%rho*patch_icpp(patch_id)%vel(i) + (1._wp - eta) & + & *patch_icpp(smooth_patch_id)%rho*patch_icpp(smooth_patch_id)%vel(i)) end do q_prim_vf(eqn_idx%gamma)%sf(j, k, l) = eta*patch_icpp(patch_id)%gamma + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma q_prim_vf(eqn_idx%E)%sf(j, k, l) = 1._wp/q_prim_vf(eqn_idx%gamma)%sf(j, k, & - & l)*(eta*patch_icpp(patch_id)%gamma*patch_icpp(patch_id)%pres + (1._wp - eta)*patch_icpp(smooth_patch_id) & - & %gamma*patch_icpp(smooth_patch_id)%pres) + & l)*(eta*patch_icpp(patch_id)%gamma*patch_icpp(patch_id)%pres + (1._wp - eta) & + & *patch_icpp(smooth_patch_id)%gamma*patch_icpp(smooth_patch_id)%pres) q_prim_vf(eqn_idx%pi_inf)%sf(j, k, l) = eta*patch_icpp(patch_id)%pi_inf + (1._wp - eta)*patch_icpp(smooth_patch_id)%pi_inf @@ -384,18 +384,18 @@ contains if (hyperelasticity) then if (pre_stress) then ! pre stressed initial condition in spatial domain - rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) - theta = atan2(y_cc(k), x_cc(j)) - phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) + rcoord = sqrt((x%cc(j)**2 + y%cc(k)**2 + z%cc(l)**2)) + theta = atan2(y%cc(k), x%cc(j)) + phi = atan2(sqrt(x%cc(j)**2 + y%cc(k)**2), z%cc(l)) ! spherical coord, assuming Rmax=1 xi_sph = (rcoord**3 - R0ref**3 + 1._wp)**(1._wp/3._wp) xi_cart(1) = xi_sph*sin(phi)*cos(theta) xi_cart(2) = xi_sph*sin(phi)*sin(theta) xi_cart(3) = xi_sph*cos(phi) else - xi_cart(1) = x_cc(j) - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) + xi_cart(1) = x%cc(j) + xi_cart(2) = y%cc(k) + xi_cart(3) = z%cc(l) end if ! assigning the reference map to the q_prim vector field @@ -464,7 +464,7 @@ contains ! Set streamwise velocity to hyperbolic tangent function of y if (mixlayer_vel_profile) then q_prim_vf(1 + eqn_idx%cont%end)%sf(j, k, & - & l) = (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(k)*mixlayer_vel_coef) + (1._wp - eta)*orig_prim_vf(1 & + & l) = (eta*patch_icpp(patch_id)%vel(1)*tanh(y%cc(k)*mixlayer_vel_coef) + (1._wp - eta)*orig_prim_vf(1 & & + eqn_idx%cont%end)) end if diff --git a/src/pre_process/m_boundary_conditions.fpp b/src/pre_process/m_boundary_conditions.fpp index 70c3485a12..b1352c2319 100644 --- a/src/pre_process/m_boundary_conditions.fpp +++ b/src/pre_process/m_boundary_conditions.fpp @@ -43,7 +43,7 @@ contains #:for BOUND, X, LOC, IDX in [('beg', '-i', -1, 1), ('end', 'm+i', 1, 2)] if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_x%${BOUND}$ < 0) then do j = 0, n - if (y_cc(j) > y_boundary%beg .and. y_cc(j) < y_boundary%end) then + if (y%cc(j) > y_boundary%beg .and. y%cc(j) < y_boundary%end) then bc_type(1, ${IDX}$)%sf(0, j, 0) = patch_bc(patch_id)%type end if end do @@ -63,7 +63,7 @@ contains #:for BOUND, Y, LOC, IDX in [('beg', '-i', -1, 1), ('end', 'n+i', 1, 2)] if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_y%${BOUND}$ < 0) then do j = 0, m - if (x_cc(j) > x_boundary%beg .and. x_cc(j) < x_boundary%end) then + if (x%cc(j) > x_boundary%beg .and. x%cc(j) < x_boundary%end) then bc_type(2, ${IDX}$)%sf(j, 0, 0) = patch_bc(patch_id)%type end if end do @@ -89,7 +89,7 @@ contains if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_x%${BOUND}$ < 0) then do k = 0, p do j = 0, n - if ((z_cc(k) - z_centroid)**2._wp + (y_cc(j) - y_centroid)**2._wp <= radius**2._wp) then + if ((z%cc(k) - z_centroid)**2._wp + (y%cc(j) - y_centroid)**2._wp <= radius**2._wp) then bc_type(1, ${IDX}$)%sf(0, j, k) = patch_bc(patch_id)%type end if end do @@ -106,7 +106,7 @@ contains if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_y%${BOUND}$ < 0) then do k = 0, p do j = 0, m - if ((z_cc(k) - z_centroid)**2._wp + (x_cc(j) - x_centroid)**2._wp <= radius**2._wp) then + if ((z%cc(k) - z_centroid)**2._wp + (x%cc(j) - x_centroid)**2._wp <= radius**2._wp) then bc_type(2, ${IDX}$)%sf(j, 0, k) = patch_bc(patch_id)%type end if end do @@ -122,7 +122,7 @@ contains if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_z%${BOUND}$ < 0) then do k = 0, n do j = 0, m - if ((y_cc(k) - y_centroid)**2._wp + (x_cc(j) - x_centroid)**2._wp <= radius**2._wp) then + if ((y%cc(k) - y_centroid)**2._wp + (x%cc(j) - x_centroid)**2._wp <= radius**2._wp) then bc_type(3, ${IDX}$)%sf(j, k, 0) = patch_bc(patch_id)%type end if end do @@ -156,8 +156,8 @@ contains if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_x%${BOUND}$ < 0) then do k = 0, p do j = 0, n - if (y_boundary%beg <= y_cc(j) .and. y_boundary%end >= y_cc(j) .and. z_boundary%beg <= z_cc(k) & - & .and. z_boundary%end >= z_cc(k)) then + if (y_boundary%beg <= y%cc(j) .and. y_boundary%end >= y%cc(j) .and. z_boundary%beg <= z%cc(k) & + & .and. z_boundary%end >= z%cc(k)) then bc_type(1, ${IDX}$)%sf(0, j, k) = patch_bc(patch_id)%type end if end do @@ -181,8 +181,8 @@ contains if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_y%${BOUND}$ < 0) then do k = 0, p do j = 0, m - if (x_boundary%beg <= x_cc(j) .and. x_boundary%end >= x_cc(j) .and. z_boundary%beg <= z_cc(k) & - & .and. z_boundary%end >= z_cc(k)) then + if (x_boundary%beg <= x%cc(j) .and. x_boundary%end >= x%cc(j) .and. z_boundary%beg <= z%cc(k) & + & .and. z_boundary%end >= z%cc(k)) then bc_type(2, ${IDX}$)%sf(j, 0, k) = patch_bc(patch_id)%type end if end do @@ -205,8 +205,8 @@ contains if (patch_bc(patch_id)%loc == ${LOC}$ .and. bc_z%${BOUND}$ < 0) then do k = 0, n do j = 0, m - if (x_boundary%beg <= x_cc(j) .and. x_boundary%end >= x_cc(j) .and. y_boundary%beg <= y_cc(k) & - & .and. y_boundary%end >= y_cc(k)) then + if (x_boundary%beg <= x%cc(j) .and. x_boundary%end >= x%cc(j) .and. y_boundary%beg <= y%cc(k) & + & .and. y_boundary%end >= y%cc(k)) then bc_type(3, ${IDX}$)%sf(j, k, 0) = patch_bc(patch_id)%type end if end do diff --git a/src/pre_process/m_check_ib_patches.fpp b/src/pre_process/m_check_ib_patches.fpp index 844d051716..db1b01543d 100644 --- a/src/pre_process/m_check_ib_patches.fpp +++ b/src/pre_process/m_check_ib_patches.fpp @@ -93,9 +93,9 @@ contains call s_int_to_str(patch_id, iStr) - @:PROHIBIT(n == 0 .or. p > 0 .or. patch_ib(patch_id)%length_x <= 0._wp .or. patch_ib(patch_id) & - & %length_y <= 0._wp .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id) & - & %y_centroid), 'in ellipse IB patch ' // trim(iStr)) + @:PROHIBIT(n == 0 .or. p > 0 .or. patch_ib(patch_id)%length_x <= 0._wp .or. patch_ib(patch_id)%length_y <= 0._wp & + & .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id)%y_centroid), & + & 'in ellipse IB patch ' // trim(iStr)) end subroutine s_check_ellipse_ib_patch_geometry @@ -107,9 +107,10 @@ contains call s_int_to_str(patch_id, iStr) - @:PROHIBIT(n == 0 .or. p > 0 .or. patch_ib(patch_id)%c <= 0._wp .or. patch_ib(patch_id)%p <= 0._wp .or. patch_ib(patch_id) & - & %t <= 0._wp .or. patch_ib(patch_id)%m <= 0._wp .or. f_is_default(patch_ib(patch_id)%x_centroid) & - & .or. f_is_default(patch_ib(patch_id)%y_centroid), 'in airfoil IB patch ' // trim(iStr)) + @:PROHIBIT(n == 0 .or. p > 0 .or. patch_ib(patch_id)%c <= 0._wp .or. patch_ib(patch_id)%p <= 0._wp & + & .or. patch_ib(patch_id)%t <= 0._wp .or. patch_ib(patch_id)%m <= 0._wp & + & .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id)%y_centroid), & + & 'in airfoil IB patch ' // trim(iStr)) end subroutine s_check_airfoil_ib_patch_geometry @@ -121,9 +122,9 @@ contains call s_int_to_str(patch_id, iStr) - @:PROHIBIT(n == 0 .or. p == 0 .or. patch_ib(patch_id)%c <= 0._wp .or. patch_ib(patch_id) & - & %p <= 0._wp .or. patch_ib(patch_id)%t <= 0._wp .or. patch_ib(patch_id) & - & %m <= 0._wp .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id)%y_centroid) & + @:PROHIBIT(n == 0 .or. p == 0 .or. patch_ib(patch_id)%c <= 0._wp .or. patch_ib(patch_id)%p <= 0._wp & + & .or. patch_ib(patch_id)%t <= 0._wp .or. patch_ib(patch_id)%m <= 0._wp & + & .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id)%y_centroid) & & .or. f_is_default(patch_ib(patch_id)%z_centroid) .or. f_is_default(patch_ib(patch_id)%length_z), & & 'in 3d airfoil IB patch ' // trim(iStr)) @@ -137,9 +138,9 @@ contains call s_int_to_str(patch_id, iStr) - @:PROHIBIT(n == 0 .or. p > 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id) & - & %y_centroid) .or. patch_ib(patch_id)%length_x <= 0._wp .or. patch_ib(patch_id)%length_y <= 0._wp, & - & 'in rectangle IB patch ' // trim(iStr)) + @:PROHIBIT(n == 0 .or. p > 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) & + & .or. f_is_default(patch_ib(patch_id)%y_centroid) .or. patch_ib(patch_id)%length_x <= 0._wp & + & .or. patch_ib(patch_id)%length_y <= 0._wp, 'in rectangle IB patch ' // trim(iStr)) end subroutine s_check_rectangle_ib_patch_geometry @@ -151,9 +152,9 @@ contains call s_int_to_str(patch_id, iStr) - @:PROHIBIT(n == 0 .or. p == 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id) & - & %y_centroid) .or. f_is_default(patch_ib(patch_id)%z_centroid) .or. patch_ib(patch_id)%radius <= 0._wp, & - & 'in sphere IB patch ' // trim(iStr)) + @:PROHIBIT(n == 0 .or. p == 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) & + & .or. f_is_default(patch_ib(patch_id)%y_centroid) .or. f_is_default(patch_ib(patch_id)%z_centroid) & + & .or. patch_ib(patch_id)%radius <= 0._wp, 'in sphere IB patch ' // trim(iStr)) end subroutine s_check_sphere_ib_patch_geometry @@ -165,10 +166,10 @@ contains call s_int_to_str(patch_id, iStr) - @:PROHIBIT(n == 0 .or. p == 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id) & - & %y_centroid) .or. f_is_default(patch_ib(patch_id)%z_centroid) .or. patch_ib(patch_id) & - & %length_x <= 0._wp .or. patch_ib(patch_id)%length_y <= 0._wp .or. patch_ib(patch_id)%length_z <= 0._wp, & - & 'in cuboid IB patch ' // trim(iStr)) + @:PROHIBIT(n == 0 .or. p == 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) & + & .or. f_is_default(patch_ib(patch_id)%y_centroid) .or. f_is_default(patch_ib(patch_id)%z_centroid) & + & .or. patch_ib(patch_id)%length_x <= 0._wp .or. patch_ib(patch_id)%length_y <= 0._wp & + & .or. patch_ib(patch_id)%length_z <= 0._wp, 'in cuboid IB patch ' // trim(iStr)) end subroutine s_check_cuboid_ib_patch_geometry @@ -181,15 +182,15 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(p == 0 .or. f_is_default(patch_ib(patch_id)%x_centroid) .or. f_is_default(patch_ib(patch_id)%y_centroid) & - & .or. f_is_default(patch_ib(patch_id)%z_centroid) .or. (patch_ib(patch_id) & - & %length_x <= 0._wp .and. patch_ib(patch_id)%length_y <= 0._wp .and. patch_ib(patch_id)%length_z <= 0._wp) & + & .or. f_is_default(patch_ib(patch_id)%z_centroid) .or. (patch_ib(patch_id)%length_x <= 0._wp & + & .and. patch_ib(patch_id)%length_y <= 0._wp .and. patch_ib(patch_id)%length_z <= 0._wp) & & .or. patch_ib(patch_id)%radius <= 0._wp, 'in cylinder IB patch ' // trim(iStr)) @:PROHIBIT((patch_ib(patch_id)%length_x > 0._wp .and. ((.not. f_is_default(patch_ib(patch_id)%length_y)) & - & .or. (.not. f_is_default(patch_ib(patch_id)%length_z)))) .or. (patch_ib(patch_id) & - & %length_y > 0._wp .and. ((.not. f_is_default(patch_ib(patch_id)%length_x)) & - & .or. (.not. f_is_default(patch_ib(patch_id)%length_z)))) .or. (patch_ib(patch_id) & - & %length_z > 0._wp .and. ((.not. f_is_default(patch_ib(patch_id)%length_x)) & + & .or. (.not. f_is_default(patch_ib(patch_id)%length_z)))) .or. (patch_ib(patch_id)%length_y > 0._wp & + & .and. ((.not. f_is_default(patch_ib(patch_id)%length_x)) & + & .or. (.not. f_is_default(patch_ib(patch_id)%length_z)))) .or. (patch_ib(patch_id)%length_z > 0._wp & + & .and. ((.not. f_is_default(patch_ib(patch_id)%length_x)) & & .or. (.not. f_is_default(patch_ib(patch_id)%length_y)))), 'in cylinder IB patch ' // trim(iStr)) end subroutine s_check_cylinder_ib_patch_geometry @@ -204,8 +205,8 @@ contains @:PROHIBIT(patch_ib(patch_id)%model_filepath == dflt_char, 'Empty model file path for patch '//trim(iStr)) - @:PROHIBIT(patch_ib(patch_id)%model_scale(1) <= 0._wp .or. patch_ib(patch_id)%model_scale(2) & - & <= 0._wp .or. patch_ib(patch_id)%model_scale(3) <= 0._wp, 'Negative scale in model IB patch ' // trim(iStr)) + @:PROHIBIT(patch_ib(patch_id)%model_scale(1) <= 0._wp .or. patch_ib(patch_id)%model_scale(2) <= 0._wp & + & .or. patch_ib(patch_id)%model_scale(3) <= 0._wp, 'Negative scale in model IB patch ' // trim(iStr)) end subroutine s_check_model_ib_patch_geometry @@ -217,8 +218,8 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT((.not. f_is_default(patch_ib(patch_id)%x_centroid)) .or. (.not. f_is_default(patch_ib(patch_id)%y_centroid)) & - & .or. (.not. f_is_default(patch_ib(patch_id)%z_centroid)) .or. (.not. f_is_default(patch_ib(patch_id) & - & %length_x)) .or. (.not. f_is_default(patch_ib(patch_id)%length_y)) & + & .or. (.not. f_is_default(patch_ib(patch_id)%z_centroid)) & + & .or. (.not. f_is_default(patch_ib(patch_id)%length_x)) .or. (.not. f_is_default(patch_ib(patch_id)%length_y)) & & .or. (.not. f_is_default(patch_ib(patch_id)%length_z)) .or. (.not. f_is_default(patch_ib(patch_id)%radius)), & & 'in inactive IB patch ' // trim(iStr)) diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index adcb233f97..ddad7e5323 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -104,10 +104,10 @@ contains ! Constraints on smoothing initial condition patch parameters do i = 1, num_patches - if (i > 1 .and. (patch_icpp(i)%geometry == 2 .or. patch_icpp(i)%geometry == 3 .or. patch_icpp(i) & - & %geometry == 4 .or. patch_icpp(i)%geometry == 5 .or. patch_icpp(i)%geometry == 8 .or. patch_icpp(i) & - & %geometry == 9 .or. patch_icpp(i)%geometry == 10 .or. patch_icpp(i)%geometry == 11 .or. patch_icpp(i) & - & %geometry == 12 .or. patch_icpp(i)%geometry == 13 .or. patch_icpp(i)%geometry == 14)) then + if (i > 1 .and. (patch_icpp(i)%geometry == 2 .or. patch_icpp(i)%geometry == 3 .or. patch_icpp(i)%geometry == 4 & + & .or. patch_icpp(i)%geometry == 5 .or. patch_icpp(i)%geometry == 8 .or. patch_icpp(i)%geometry == 9 & + & .or. patch_icpp(i)%geometry == 10 .or. patch_icpp(i)%geometry == 11 .or. patch_icpp(i)%geometry == 12 & + & .or. patch_icpp(i)%geometry == 13 .or. patch_icpp(i)%geometry == 14)) then call s_check_supported_patch_smoothing(i) else call s_check_unsupported_patch_smoothing(i) @@ -462,11 +462,13 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(f_is_default(patch_icpp(patch_id)%vel(1)), "Patch "//trim(iStr)//": vel(1) must be set") - @:PROHIBIT(n == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(2))) .and. (.not. f_approx_equal(patch_icpp(patch_id) & - & %vel(2), 0._wp)) .and. (.not. mhd), "Patch " // trim(iStr) // ": vel(2) must not be set when n = 0") + @:PROHIBIT(n == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(2))) & + & .and. (.not. f_approx_equal(patch_icpp(patch_id)%vel(2), 0._wp)) .and. (.not. mhd), & + & "Patch " // trim(iStr) // ": vel(2) must not be set when n = 0") @:PROHIBIT(n > 0 .and. f_is_default(patch_icpp(patch_id)%vel(2)), "Patch "//trim(iStr)//": vel(2) must be set when n > 0") - @:PROHIBIT(p == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(3))) .and. (.not. f_approx_equal(patch_icpp(patch_id) & - & %vel(3), 0._wp)) .and. (.not. mhd), "Patch " // trim(iStr) // ": vel(3) must not be set when p = 0") + @:PROHIBIT(p == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(3))) & + & .and. (.not. f_approx_equal(patch_icpp(patch_id)%vel(3), 0._wp)) .and. (.not. mhd), & + & "Patch " // trim(iStr) // ": vel(3) must not be set when p = 0") @:PROHIBIT(p > 0 .and. f_is_default(patch_icpp(patch_id)%vel(3)), "Patch "//trim(iStr)//": vel(3) must be set when p > 0") @:PROHIBIT(mhd .and. (f_is_default(patch_icpp(patch_id)%vel(2)) .or. f_is_default(patch_icpp(patch_id)%vel(3))), & & "Patch " // trim(iStr) // ": All velocities (vel(1:3)) must be set when mhd = true") diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index e8583242ad..63b718fb25 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -94,19 +94,19 @@ contains file_loc = trim(t_step_dir) // '/x_cb.dat' open (1, FILE=trim(file_loc), form='unformatted', STATUS=status) - write (1) x_cb(-1:m) + write (1) x%cb(-1:m) close (1) if (n > 0) then file_loc = trim(t_step_dir) // '/y_cb.dat' open (1, FILE=trim(file_loc), form='unformatted', STATUS=status) - write (1) y_cb(-1:n) + write (1) y%cb(-1:n) close (1) if (p > 0) then file_loc = trim(t_step_dir) // '/z_cb.dat' open (1, FILE=trim(file_loc), form='unformatted', STATUS=status) - write (1) z_cb(-1:p) + write (1) z%cb(-1:p) close (1) end if end if @@ -179,15 +179,15 @@ contains lit_gamma = 1._wp/gamma + 1._wp if ((i >= eqn_idx%species%beg) .and. (i <= eqn_idx%species%end)) then - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0)/rho else if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & & .and. (i <= eqn_idx%adv%end)) .or. ((i >= eqn_idx%species%beg) .and. (i <= eqn_idx%species%end) & & )) then - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0) else if (i == eqn_idx%mom%beg) then ! u - write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)/rho else if (i == eqn_idx%stress%beg) then ! tau_e - write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%stress%beg)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(eqn_idx%stress%beg)%sf(j, 0, 0)/rho else if (i == eqn_idx%E) then ! p if (mhd) then pres_mag = 0.5_wp*(Bx0**2 + q_cons_vf(eqn_idx%B%beg)%sf(j, 0, & @@ -197,16 +197,16 @@ contains call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j, 0, 0), q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), & & 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)**2._wp)/rho, pi_inf, gamma, & & rho, qv, rhoYks, pres, T, pres_mag=pres_mag) - write (2, FMT) x_cb(j), pres + write (2, FMT) x%cb(j), pres else if (mhd) then if (i == eqn_idx%mom%beg + 1) then ! v - write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, 0, 0)/rho else if (i == eqn_idx%mom%beg + 2) then ! w - write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, 0, 0)/rho else if (i == eqn_idx%B%beg) then ! By - write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%B%beg)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(eqn_idx%B%beg)%sf(j, 0, 0)/rho else if (i == eqn_idx%B%beg + 1) then ! Bz - write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%B%beg + 1)%sf(j, 0, 0)/rho + write (2, FMT) x%cb(j), q_cons_vf(eqn_idx%B%beg + 1)%sf(j, 0, 0)/rho end if else if ((i >= eqn_idx%bub%beg) .and. (i <= eqn_idx%bub%end) .and. bubbles_euler) then if (qbmm) then @@ -222,11 +222,11 @@ contains call s_comp_n_from_cons(real(q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), kind=wp), nRtmp, nbub, weight) end if end if - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/nbub + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0)/nbub else if (i == eqn_idx%n .and. adv_n .and. bubbles_euler) then - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0) else if (i == eqn_idx%damage) then - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0) end if end do close (2) @@ -238,7 +238,7 @@ contains open (2, FILE=trim(file_loc)) do j = 0, m - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0) end do close (2) end do @@ -251,7 +251,7 @@ contains open (2, FILE=trim(file_loc)) do j = 0, m - write (2, FMT) x_cb(j), pb%sf(j, 0, 0, r, i) + write (2, FMT) x%cb(j), pb%sf(j, 0, 0, r, i) end do close (2) end do @@ -263,7 +263,7 @@ contains open (2, FILE=trim(file_loc)) do j = 0, m - write (2, FMT) x_cb(j), mv%sf(j, 0, 0, r, i) + write (2, FMT) x%cb(j), mv%sf(j, 0, 0, r, i) end do close (2) end do @@ -283,7 +283,7 @@ contains open (2, FILE=trim(file_loc)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), q_cons_vf(i)%sf(j, k, 0) + write (2, FMT) x%cb(j), y%cb(k), q_cons_vf(i)%sf(j, k, 0) end do write (2, *) end do @@ -299,7 +299,7 @@ contains open (2, FILE=trim(file_loc)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), pb%sf(j, k, 0, r, i) + write (2, FMT) x%cb(j), y%cb(k), pb%sf(j, k, 0, r, i) end do end do close (2) @@ -313,7 +313,7 @@ contains open (2, FILE=trim(file_loc)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), mv%sf(j, k, 0, r, i) + write (2, FMT) x%cb(j), y%cb(k), mv%sf(j, k, 0, r, i) end do end do close (2) @@ -335,7 +335,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), q_cons_vf(i)%sf(j, k, l) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), q_cons_vf(i)%sf(j, k, l) end do write (2, *) end do @@ -354,7 +354,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), pb%sf(j, k, l, r, i) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), pb%sf(j, k, l, r, i) end do end do end do @@ -370,7 +370,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), mv%sf(j, k, l, r, i) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), mv%sf(j, k, l, r, i) end do end do end do diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index e93d4c3122..17b7f2397a 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -41,18 +41,15 @@ module m_global_parameters integer :: num_vels !< Number of velocity components (different from num_dims for mhd) logical :: cyl_coord integer :: grid_geometry !< Cylindrical coordinates (either axisymmetric or full 3D) - !> Locations of cell-centers (cc) in x-, y- and z-directions, respectively - real(wp), allocatable, dimension(:) :: x_cc, y_cc, z_cc - !> Locations of cell-boundaries (cb) in x-, y- and z-directions, respectively - real(wp), allocatable, dimension(:) :: x_cb, y_cb, z_cb - real(wp) :: dx, dy, dz !< Minimum cell-widths in the x-, y- and z-coordinate directions + !> Cell-boundary (cb) and cell-center (cc) arrays per direction + type(grid_axis) :: x, y, z + real(wp) :: dx, dy, dz !< Minimum cell-widths in the x-, y- and z-coordinate directions type(bounds_info) :: x_domain, y_domain, z_domain !< Locations of the domain bounds in the x-, y- and z-coordinate directions - logical :: stretch_x, stretch_y, stretch_z !< Grid stretching flags for the x-, y- and z-coordinate directions - ! Grid stretching: a_x/a_y/a_z = rate, x_a/y_a/z_a = location - real(wp) :: a_x, a_y, a_z - integer :: loops_x, loops_y, loops_z - real(wp) :: x_a, y_a, z_a - real(wp) :: x_b, y_b, z_b + logical :: stretch_x, stretch_y, stretch_z !< Grid stretching flags for the x-, y- and z-coordinate directions + ! Grid stretching: a_x/a_y/a_z = rate, x_stretch%beg/end = locations + real(wp) :: a_x, a_y, a_z + integer :: loops_x, loops_y, loops_z + type(bounds_info) :: x_stretch, y_stretch, z_stretch ! Simulation Algorithm Parameters integer :: model_eqns !< Multicomponent flow model @@ -232,12 +229,12 @@ contains loops_x = 1 loops_y = 1 loops_z = 1 - x_a = dflt_real - x_b = dflt_real - y_a = dflt_real - y_b = dflt_real - z_a = dflt_real - z_b = dflt_real + x_stretch%beg = dflt_real + x_stretch%end = dflt_real + y_stretch%beg = dflt_real + y_stretch%end = dflt_real + z_stretch%beg = dflt_real + z_stretch%end = dflt_real ! Simulation algorithm parameters model_eqns = dflt_int @@ -810,12 +807,12 @@ contains #endif ! Allocating grid variables for the x-direction - allocate (x_cc(0:m), x_cb(-1:m)) + allocate (x%cc(0:m), x%cb(-1:m)) ! Allocating grid variables for the y- and z-directions if (n > 0) then - allocate (y_cc(0:n), y_cb(-1:n)) + allocate (y%cc(0:n), y%cb(-1:n)) if (p > 0) then - allocate (z_cc(0:p), z_cb(-1:p)) + allocate (z%cc(0:p), z%cb(-1:p)) end if end if @@ -879,12 +876,12 @@ contains ! Deallocating grid variables for the x-direction - deallocate (x_cc, x_cb) + deallocate (x%cc, x%cb) ! Deallocating grid variables for the y- and z-directions if (n > 0) then - deallocate (y_cc, y_cb) + deallocate (y%cc, y%cb) if (p > 0) then - deallocate (z_cc, z_cb) + deallocate (z%cc, z%cb) end if end if diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 77cb02cef2..9abed16500 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -41,31 +41,31 @@ impure subroutine s_generate_serial_grid dx = (x_domain%end - x_domain%beg)/real(m + 1, wp) do i = 0, m - x_cc(i) = x_domain%beg + 5.e-1_wp*dx*real(2*i + 1, wp) - x_cb(i - 1) = x_domain%beg + dx*real(i, wp) + x%cc(i) = x_domain%beg + 5.e-1_wp*dx*real(2*i + 1, wp) + x%cb(i - 1) = x_domain%beg + dx*real(i, wp) end do - x_cb(m) = x_domain%end + x%cb(m) = x_domain%end ! Hyperbolic tangent grid stretching if (stretch_x) then - length = abs(x_cb(m) - x_cb(-1)) - x_cb = x_cb/length - x_a = x_a/length - x_b = x_b/length + length = abs(x%cb(m) - x%cb(-1)) + x%cb = x%cb/length + x_stretch%beg = x_stretch%beg/length + x_stretch%end = x_stretch%end/length do j = 1, loops_x do i = -1, m - x_cb(i) = x_cb(i)/a_x*(a_x + log(cosh(a_x*(x_cb(i) - x_a))) + log(cosh(a_x*(x_cb(i) - x_b))) & - & - 2._wp*log(cosh(a_x*(x_b - x_a)/2._wp))) + x%cb(i) = x%cb(i)/a_x*(a_x + log(cosh(a_x*(x%cb(i) - x_stretch%beg))) + log(cosh(a_x*(x%cb(i) - x_stretch%end) & + & )) - 2._wp*log(cosh(a_x*(x_stretch%end - x_stretch%beg)/2._wp))) end do end do - x_cb = x_cb*length + x%cb = x%cb*length - x_cc(0:m) = (x_cb(0:m) + x_cb(-1:m - 1))/2._wp + x%cc(0:m) = (x%cb(0:m) + x%cb(-1:m - 1))/2._wp - dx = minval(x_cb(0:m) - x_cb(-1:m - 1)) - print *, 'Stretched grid: min/max x grid: ', minval(x_cc(:)), maxval(x_cc(:)) + dx = minval(x%cb(0:m) - x%cb(-1:m - 1)) + print *, 'Stretched grid: min/max x grid: ', minval(x%cc(:)), maxval(x%cc(:)) if (num_procs > 1) call s_mpi_reduce_min(dx) end if @@ -76,42 +76,42 @@ impure subroutine s_generate_serial_grid if (grid_geometry == 2 .and. f_approx_equal(y_domain%beg, 0.0_wp)) then dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp) - y_cc(0) = y_domain%beg + 5.e-1_wp*dy - y_cb(-1) = y_domain%beg + y%cc(0) = y_domain%beg + 5.e-1_wp*dy + y%cb(-1) = y_domain%beg do i = 1, n - y_cc(i) = y_domain%beg + 2._wp*dy*real(i, wp) - y_cb(i - 1) = y_domain%beg + dy*real(2*i - 1, wp) + y%cc(i) = y_domain%beg + 2._wp*dy*real(i, wp) + y%cb(i - 1) = y_domain%beg + dy*real(2*i - 1, wp) end do else dy = (y_domain%end - y_domain%beg)/real(n + 1, wp) do i = 0, n - y_cc(i) = y_domain%beg + 5.e-1_wp*dy*real(2*i + 1, wp) - y_cb(i - 1) = y_domain%beg + dy*real(i, wp) + y%cc(i) = y_domain%beg + 5.e-1_wp*dy*real(2*i + 1, wp) + y%cb(i - 1) = y_domain%beg + dy*real(i, wp) end do end if - y_cb(n) = y_domain%end + y%cb(n) = y_domain%end ! Hyperbolic tangent grid stretching in y-direction if (stretch_y) then - length = abs(y_cb(n) - y_cb(-1)) - y_cb = y_cb/length - y_a = y_a/length - y_b = y_b/length + length = abs(y%cb(n) - y%cb(-1)) + y%cb = y%cb/length + y_stretch%beg = y_stretch%beg/length + y_stretch%end = y_stretch%end/length do j = 1, loops_y do i = -1, n - y_cb(i) = y_cb(i)/a_y*(a_y + log(cosh(a_y*(y_cb(i) - y_a))) + log(cosh(a_y*(y_cb(i) - y_b))) & - & - 2._wp*log(cosh(a_y*(y_b - y_a)/2._wp))) + y%cb(i) = y%cb(i)/a_y*(a_y + log(cosh(a_y*(y%cb(i) - y_stretch%beg))) + log(cosh(a_y*(y%cb(i) - y_stretch%end) & + & )) - 2._wp*log(cosh(a_y*(y_stretch%end - y_stretch%beg)/2._wp))) end do end do - y_cb = y_cb*length - y_cc(0:n) = (y_cb(0:n) + y_cb(-1:n - 1))/2._wp + y%cb = y%cb*length + y%cc(0:n) = (y%cb(0:n) + y%cb(-1:n - 1))/2._wp - dy = minval(y_cb(0:n) - y_cb(-1:n - 1)) + dy = minval(y%cb(0:n) - y%cb(-1:n - 1)) if (num_procs > 1) call s_mpi_reduce_min(dy) end if @@ -122,30 +122,30 @@ impure subroutine s_generate_serial_grid dz = (z_domain%end - z_domain%beg)/real(p + 1, wp) do i = 0, p - z_cc(i) = z_domain%beg + 5.e-1_wp*dz*real(2*i + 1, wp) - z_cb(i - 1) = z_domain%beg + dz*real(i, wp) + z%cc(i) = z_domain%beg + 5.e-1_wp*dz*real(2*i + 1, wp) + z%cb(i - 1) = z_domain%beg + dz*real(i, wp) end do - z_cb(p) = z_domain%end + z%cb(p) = z_domain%end ! Hyperbolic tangent grid stretching in z-direction if (stretch_z) then - length = abs(z_cb(p) - z_cb(-1)) - z_cb = z_cb/length - z_a = z_a/length - z_b = z_b/length + length = abs(z%cb(p) - z%cb(-1)) + z%cb = z%cb/length + z_stretch%beg = z_stretch%beg/length + z_stretch%end = z_stretch%end/length do j = 1, loops_z do i = -1, p - z_cb(i) = z_cb(i)/a_z*(a_z + log(cosh(a_z*(z_cb(i) - z_a))) + log(cosh(a_z*(z_cb(i) - z_b))) & - & - 2._wp*log(cosh(a_z*(z_b - z_a)/2._wp))) + z%cb(i) = z%cb(i)/a_z*(a_z + log(cosh(a_z*(z%cb(i) - z_stretch%beg))) + log(cosh(a_z*(z%cb(i) - z_stretch%end) & + & )) - 2._wp*log(cosh(a_z*(z_stretch%end - z_stretch%beg)/2._wp))) end do end do - z_cb = z_cb*length - z_cc(0:p) = (z_cb(0:p) + z_cb(-1:p - 1))/2._wp + z%cb = z%cb*length + z%cc(0:p) = (z%cb(0:p) + z%cb(-1:p - 1))/2._wp - dz = minval(z_cb(0:p) - z_cb(-1:p - 1)) + dz = minval(z%cb(0:p) - z%cb(-1:p - 1)) if (num_procs > 1) call s_mpi_reduce_min(dz) end if @@ -180,13 +180,13 @@ impure subroutine s_generate_parallel_grid x_cb_glb = x_cb_glb/length - x_a = x_a/length - x_b = x_b/length + x_stretch%beg = x_stretch%beg/length + x_stretch%end = x_stretch%end/length do j = 1, loops_x do i = -1, m_glb - x_cb_glb(i) = x_cb_glb(i)/a_x*(a_x + log(cosh(a_x*(x_cb_glb(i) - x_a))) + log(cosh(a_x*(x_cb_glb(i) - x_b))) & - & - 2._wp*log(cosh(a_x*(x_b - x_a)/2._wp))) + x_cb_glb(i) = x_cb_glb(i)/a_x*(a_x + log(cosh(a_x*(x_cb_glb(i) - x_stretch%beg))) + log(cosh(a_x*(x_cb_glb(i) & + & - x_stretch%end))) - 2._wp*log(cosh(a_x*(x_stretch%end - x_stretch%beg)/2._wp))) end do end do @@ -214,13 +214,14 @@ impure subroutine s_generate_parallel_grid y_cb_glb = y_cb_glb/length - y_a = y_a/length - y_b = y_b/length + y_stretch%beg = y_stretch%beg/length + y_stretch%end = y_stretch%end/length do j = 1, loops_y do i = -1, n_glb - y_cb_glb(i) = y_cb_glb(i)/a_y*(a_y + log(cosh(a_y*(y_cb_glb(i) - y_a))) + log(cosh(a_y*(y_cb_glb(i) - y_b) & - & )) - 2._wp*log(cosh(a_y*(y_b - y_a)/2._wp))) + y_cb_glb(i) = y_cb_glb(i)/a_y*(a_y + log(cosh(a_y*(y_cb_glb(i) - y_stretch%beg))) & + & + log(cosh(a_y*(y_cb_glb(i) - y_stretch%end))) - 2._wp*log(cosh(a_y*(y_stretch%end & + & - y_stretch%beg)/2._wp))) end do end do @@ -238,13 +239,14 @@ impure subroutine s_generate_parallel_grid length = abs(z_cb_glb(p_glb) - z_cb_glb(-1)) z_cb_glb = z_cb_glb/length - z_a = z_a/length - z_b = z_b/length + z_stretch%beg = z_stretch%beg/length + z_stretch%end = z_stretch%end/length do j = 1, loops_z do i = -1, p_glb - z_cb_glb(i) = z_cb_glb(i)/a_z*(a_z + log(cosh(a_z*(z_cb_glb(i) - z_a))) + log(cosh(a_z*(z_cb_glb(i) & - & - z_b))) - 2._wp*log(cosh(a_z*(z_b - z_a)/2._wp))) + z_cb_glb(i) = z_cb_glb(i)/a_z*(a_z + log(cosh(a_z*(z_cb_glb(i) - z_stretch%beg))) & + & + log(cosh(a_z*(z_cb_glb(i) - z_stretch%end))) - 2._wp*log(cosh(a_z*(z_stretch%end & + & - z_stretch%beg)/2._wp))) end do end do diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 75104dda37..2ea6a4bdca 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -193,7 +193,7 @@ contains ! Assign patch vars if cell is covered and patch has write permission do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, & + if (x_boundary%beg <= x%cc(i) .and. x_boundary%end >= x%cc(i) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, & & 0, 0))) then call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp) @@ -250,7 +250,7 @@ contains spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/)) do j = 0, n; do i = 0, m - if ((x_cc(i) > spiral_x_min) .and. (x_cc(i) < spiral_x_max) .and. (y_cc(j) > spiral_y_min) .and. (y_cc(j) & + if ((x%cc(i) > spiral_x_min) .and. (x%cc(i) < spiral_x_max) .and. (y%cc(j) > spiral_y_min) .and. (y%cc(j) & & < spiral_y_max)) then logic_grid(i, j, 0) = 1 end if @@ -313,11 +313,12 @@ contains if (patch_icpp(patch_id)%smoothen) then ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness eta = tanh(smooth_coeff/min(dx, & - & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp + & dy)*(sqrt((x%cc(i) - x_centroid)**2 + (y%cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp end if - if (((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2 <= radius**2 .and. patch_icpp(patch_id) & - & %alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then + if (((x%cc(i) - x_centroid)**2 + (y%cc(j) - y_centroid)**2 <= radius**2 & + & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, & + & 0) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp) @:analytical() @@ -365,10 +366,10 @@ contains ! Assign patch vars if cell is covered and patch has write permission do j = 0, n do i = 0, m - myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) + myr = sqrt((x%cc(i) - x_centroid)**2 + (y%cc(j) - y_centroid)**2) - if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp .and. patch_icpp(patch_id) & - & %alter_patch(patch_id_fp(i, j, 0))) then + if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp & + & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp) @:analytical() @@ -427,10 +428,10 @@ contains do k = 0, p do j = 0, n do i = 0, m - myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) + myr = sqrt((x%cc(i) - x_centroid)**2 + (y%cc(j) - y_centroid)**2) - if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp .and. patch_icpp(patch_id) & - & %alter_patch(patch_id_fp(i, j, k))) then + if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp & + & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp) @:analytical() @@ -485,12 +486,13 @@ contains do i = 0, m if (patch_icpp(patch_id)%smoothen) then eta = tanh(smooth_coeff/min(dx, & - & dy)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) & + & dy)*(sqrt(((x%cc(i) - x_centroid)/a)**2 + ((y%cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) & & + 0.5_wp end if - if ((((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2 <= 1._wp .and. patch_icpp(patch_id) & - & %alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then + if ((((x%cc(i) - x_centroid)/a)**2 + ((y%cc(j) - y_centroid)/b)**2 <= 1._wp & + & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, & + & 0) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp) @:analytical() @@ -546,20 +548,20 @@ contains do j = 0, n do i = 0, m if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + call s_convert_cylindrical_to_cartesian_coord(y%cc(j), z%cc(k)) else - cart_y = y_cc(j) - cart_z = z_cc(k) + cart_y = y%cc(j) + cart_z = z%cc(k) end if if (patch_icpp(patch_id)%smoothen) then eta = tanh(smooth_coeff/min(dx, dy, & - & dz)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z & + & dz)*(sqrt(((x%cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z & & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp end if - if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c) & - & **2 <= 1._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, & + if ((((x%cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c)**2 <= 1._wp & + & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, & & k) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp) @@ -620,8 +622,8 @@ contains ! Assign patch vars if cell is covered and patch has write permission do j = 0, n do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) & - & .and. y_boundary%end >= y_cc(j)) then + if (x_boundary%beg <= x%cc(i) .and. x_boundary%end >= x%cc(i) .and. y_boundary%beg <= y%cc(j) & + & .and. y_boundary%end >= y%cc(j)) then if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp) @@ -634,8 +636,8 @@ contains if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then ! zero density, reassign according to Tait EOS q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(eqn_idx%E)%sf(i, j, & - & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp - q_prim_vf(eqn_idx%alf) & - & %sf(i, j, 0)) + & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp & + & - q_prim_vf(eqn_idx%alf)%sf(i, j, 0)) end if ! Updating the patch identities bookkeeping variable @@ -686,10 +688,10 @@ contains do j = 0, n do i = 0, m if (patch_icpp(patch_id)%smoothen) then - eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy)*(a*x_cc(i) + b*y_cc(j) + c)/sqrt(a**2 + b**2)) + eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy)*(a*x%cc(i) + b*y%cc(j) + c)/sqrt(a**2 + b**2)) end if - if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, & + if ((a*x%cc(i) + b*y%cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, & & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp) @@ -751,8 +753,8 @@ contains ! Assign patch vars if cell is covered and patch has write permission do j = 0, n do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. y_boundary%beg <= y_cc(j) & - & .and. y_boundary%end >= y_cc(j) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then + if (x_boundary%beg <= x%cc(i) .and. x_boundary%end >= x%cc(i) .and. y_boundary%beg <= y%cc(j) & + & .and. y_boundary%end >= y%cc(j) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp) @:analytical() @@ -764,10 +766,10 @@ contains if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id ! Assign Parameters - q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) - q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = U0*sin(x%cc(i)/L0)*cos(y%cc(j)/L0) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -U0*cos(x%cc(i)/L0)*sin(y%cc(j)/L0) q_prim_vf(eqn_idx%E)%sf(i, j, & - & 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/L0 + cos(2*y_cc(j))/L0)*(q_prim_vf(1)%sf(i, j, & + & 0) = patch_icpp(patch_id)%pres + (cos(2*x%cc(i))/L0 + cos(2*y%cc(j))/L0)*(q_prim_vf(1)%sf(i, j, & & 0)*U0*U0)/16 end if end do @@ -816,7 +818,7 @@ contains ! Assign patch vars if cell is covered and patch has write permission do i = 0, m - if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, & + if (x_boundary%beg <= x%cc(i) .and. x_boundary%end >= x%cc(i) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, & & 0, 0))) then call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp) @@ -855,11 +857,11 @@ contains do j = 0, n do i = 0, m - r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) + r = sqrt((x%cc(i) - x_centroid)**2 + (y%cc(j) - y_centroid)**2) if (r < small_radius) then theta = 0._wp else - theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid) + theta = atan2(y%cc(j) - y_centroid, x%cc(i) - x_centroid) end if sum_series = 0._wp do nn = 1, max_2d_fourier_modes @@ -913,14 +915,14 @@ contains do j = 0, n do i = 0, m if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) - dx_loc = x_cc(i) - x_centroid + call s_convert_cylindrical_to_cartesian_coord(y%cc(j), z%cc(k)) + dx_loc = x%cc(i) - x_centroid dy_loc = cart_y - y_centroid dz_loc = cart_z - z_centroid else - dx_loc = x_cc(i) - x_centroid - dy_loc = y_cc(j) - y_centroid - dz_loc = z_cc(k) - z_centroid + dx_loc = x%cc(i) - x_centroid + dy_loc = y%cc(j) - y_centroid + dz_loc = z%cc(k) - z_centroid end if r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2) if (r < small_radius) then @@ -989,19 +991,19 @@ contains do j = 0, n do i = 0, m if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + call s_convert_cylindrical_to_cartesian_coord(y%cc(j), z%cc(k)) else - cart_y = y_cc(j) - cart_z = z_cc(k) + cart_y = y%cc(j) + cart_z = z%cc(k) end if if (patch_icpp(patch_id)%smoothen) then eta = tanh(smooth_coeff/min(dx, dy, & - & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) & + & dz)*(sqrt((x%cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) & & - radius))*(-0.5_wp) + 0.5_wp end if - if ((((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2) & + if ((((x%cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2) & & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, & & k) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp) @@ -1061,14 +1063,14 @@ contains do j = 0, n do i = 0, m if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + call s_convert_cylindrical_to_cartesian_coord(y%cc(j), z%cc(k)) else - cart_y = y_cc(j) - cart_z = z_cc(k) + cart_y = y%cc(j) + cart_z = z%cc(k) end if - if (x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i) & - & .and. y_boundary%beg <= cart_y .and. y_boundary%end >= cart_y .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) then + if (x_boundary%beg <= x%cc(i) .and. x_boundary%end >= x%cc(i) .and. y_boundary%beg <= cart_y & + & .and. y_boundary%end >= cart_y .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) then if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp) @@ -1136,10 +1138,10 @@ contains do j = 0, n do i = 0, m if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + call s_convert_cylindrical_to_cartesian_coord(y%cc(j), z%cc(k)) else - cart_y = y_cc(j) - cart_z = z_cc(k) + cart_y = y%cc(j) + cart_z = z%cc(k) end if if (patch_icpp(patch_id)%smoothen) then @@ -1149,21 +1151,20 @@ contains & + 0.5_wp else if (.not. f_is_default(length_y)) then eta = tanh(smooth_coeff/min(dx, & - & dz)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) & + & dz)*(sqrt((x%cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) & & + 0.5_wp else eta = tanh(smooth_coeff/min(dx, & - & dy)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) & + & dy)*(sqrt((x%cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) & & + 0.5_wp end if end if - if (((.not. f_is_default(length_x) .and. (cart_y - y_centroid)**2 + (cart_z - z_centroid) & - & **2 <= radius**2 .and. x_boundary%beg <= x_cc(i) .and. x_boundary%end >= x_cc(i)) & - & .or. (.not. f_is_default(length_y) .and. (x_cc(i) - x_centroid)**2 + (cart_z - z_centroid) & - & **2 <= radius**2 .and. y_boundary%beg <= cart_y .and. y_boundary%end >= cart_y) & - & .or. (.not. f_is_default(length_z) .and. (x_cc(i) - x_centroid)**2 + (cart_y - y_centroid) & - & **2 <= radius**2 .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) & + if (((.not. f_is_default(length_x) .and. (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2 & + & .and. x_boundary%beg <= x%cc(i) .and. x_boundary%end >= x%cc(i)) .or. (.not. f_is_default(length_y) & + & .and. (x%cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2 <= radius**2 .and. y_boundary%beg <= cart_y & + & .and. y_boundary%end >= cart_y) .or. (.not. f_is_default(length_z) .and. (x%cc(i) - x_centroid)**2 & + & + (cart_y - y_centroid)**2 <= radius**2 .and. z_boundary%beg <= cart_z .and. z_boundary%end >= cart_z) & & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, & & k) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp) @@ -1224,18 +1225,18 @@ contains do j = 0, n do i = 0, m if (grid_geometry == 3) then - call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) + call s_convert_cylindrical_to_cartesian_coord(y%cc(j), z%cc(k)) else - cart_y = y_cc(j) - cart_z = z_cc(k) + cart_y = y%cc(j) + cart_z = z%cc(k) end if if (patch_icpp(patch_id)%smoothen) then eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, & - & dz)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2)) + & dz)*(a*x%cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2)) end if - if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, & + if ((a*x%cc(i) + b*cart_y + c*cart_z + d >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, & & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp) @@ -1325,11 +1326,11 @@ contains write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3) - grid_mm(1,:) = (/minval(x_cc) - 0.e5_wp*dx, maxval(x_cc) + 0.e5_wp*dx/) - grid_mm(2,:) = (/minval(y_cc) - 0.e5_wp*dy, maxval(y_cc) + 0.e5_wp*dy/) + grid_mm(1,:) = (/minval(x%cc) - 0.e5_wp*dx, maxval(x%cc) + 0.e5_wp*dx/) + grid_mm(2,:) = (/minval(y%cc) - 0.e5_wp*dy, maxval(y%cc) + 0.e5_wp*dy/) if (p > 0) then - grid_mm(3,:) = (/minval(z_cc) - 0.e5_wp*dz, maxval(z_cc) + 0.e5_wp*dz/) + grid_mm(3,:) = (/minval(z%cc) - 0.e5_wp*dz, maxval(z%cc) + 0.e5_wp*dz/) else grid_mm(3,:) = (/0._wp, 0._wp/) end if @@ -1346,9 +1347,9 @@ contains write (*, "(A, I3, A)", advance="no") char(13) // " * Generating grid: ", nint(100*real(cell_num)/ncells), "%" end if - point = (/x_cc(i), y_cc(j), 0._wp/) + point = (/x%cc(i), y%cc(j), 0._wp/) if (p > 0) then - point(3) = z_cc(k) + point(3) = z%cc(k) end if if (grid_geometry == 3) then diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index cad964ace4..4893855e71 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -52,9 +52,10 @@ contains #:endfor call MPI_BCAST(fluid_rho(1), num_fluids_max, mpi_p, 0, MPI_COMM_WORLD, ierr) - #:for VAR in [ 'x_domain%beg', 'x_domain%end', 'y_domain%beg', & - & 'y_domain%end', 'z_domain%beg', 'z_domain%end', 'a_x', 'a_y', & - & 'a_z', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', 'z_b', 'bc_x%beg', & + #:for VAR in [ 'x_domain%beg', 'x_domain%end', 'y_domain%beg', & + & 'y_domain%end', 'z_domain%beg', 'z_domain%end', 'a_x', 'a_y', & + & 'a_z', 'x_stretch%beg', 'x_stretch%end', 'y_stretch%beg', 'y_stretch%end', & + & 'z_stretch%beg', 'z_stretch%end', 'bc_x%beg', & & 'bc_x%end', 'bc_y%beg', 'bc_y%end', 'bc_z%beg', 'bc_z%end', & & 'perturb_flow_mag', 'pref', 'rhoref', 'poly_sigma', 'R0ref', & & 'Web', 'Ca', 'Re_inv', 'sigR', 'sigV', 'rhoRV', 'palpha_eps', & diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 8472b47430..b1d473ce05 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -172,12 +172,12 @@ contains do l = 0, p do k = 0, n do j = 0, m - xl = freq*(x_cc(j) + ofs(i, 1)) - yl = freq*(y_cc(k) + ofs(i, 2)) + xl = freq*(x%cc(j) + ofs(i, 1)) + yl = freq*(y%cc(k) + ofs(i, 2)) if (num_dims == 2) then mag = f_simplex2d(xl, yl) else if (num_dims == 3) then - zl = freq*(z_cc(l) + ofs(i, 3)) + zl = freq*(z%cc(l) + ofs(i, 3)) mag = f_simplex3d(xl, yl, zl) end if @@ -210,12 +210,12 @@ contains do l = 0, p do k = 0, n do j = 0, m - xl = freq*(x_cc(j) + ofs(i, 1)) - yl = freq*(y_cc(k) + ofs(i, 2)) + xl = freq*(x%cc(j) + ofs(i, 1)) + yl = freq*(y%cc(k) + ofs(i, 2)) if (num_dims == 2) then mag = f_simplex2d(xl, yl) else if (num_dims == 3) then - zl = freq*(z_cc(l) + ofs(i, 3)) + zl = freq*(z%cc(l) + ofs(i, 3)) mag = f_simplex3d(xl, yl, zl) end if q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, & @@ -255,7 +255,7 @@ contains do r = 0, n ! Compute prescribed Reynolds stress tensor with about half magnitude of its self-similar value Rij(:,:) = 0._wp - uu0 = patch_icpp(1)%vel(1)**2._wp*(1._wp - tanh(y_cc(r)*mixlayer_vel_coef)**2._wp) + uu0 = patch_icpp(1)%vel(1)**2._wp*(1._wp - tanh(y%cc(r)*mixlayer_vel_coef)**2._wp) Rij(1, 1) = 0.05_wp*uu0 Rij(2, 2) = 0.03_wp*uu0 Rij(3, 3) = 0.03_wp*uu0 @@ -277,7 +277,7 @@ contains do i = 1, mixlayer_perturb_nk ! Generate random numbers for unit wavevector khat, random unit vector xi, and random mode phase phi if (proc_rank == 0) then - call s_generate_random_perturbation(khat, xi, phi, i, y_cc(r)) + call s_generate_random_perturbation(khat, xi, phi, i, y%cc(r)) end if #ifdef MFC_MPI @@ -295,7 +295,7 @@ contains do l = 0, p do j = 0, m q = sqrt(Ek(i)/Eksum) - alpha = k(i)*(khat(1)*x_cc(j) + khat(2)*y_cc(r) + khat(3)*z_cc(l)) + 2._wp*pi*phi + alpha = k(i)*(khat(1)*x%cc(j) + khat(2)*y%cc(r) + khat(3)*z%cc(l)) + 2._wp*pi*phi velfluc = 2._wp*q*sig*cos(alpha) velfluc = matmul(Lmat, velfluc) q_prim_vf(eqn_idx%mom%beg)%sf(j, r, l) = q_prim_vf(eqn_idx%mom%beg)%sf(j, r, l) + velfluc(1) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 25597baad7..c4d33bc25b 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -75,7 +75,7 @@ contains character(len=1000) :: line namelist /user_inputs/ case_dir, old_grid, old_ic, t_step_old, t_step_start, m, n, p, x_domain, y_domain, z_domain, & - & stretch_x, stretch_y, stretch_z, a_x, a_y, a_z, x_a, y_a, z_a, x_b, y_b, z_b, model_eqns, num_fluids, mpp_lim, & + & stretch_x, stretch_y, stretch_z, a_x, a_y, a_z, x_stretch, y_stretch, z_stretch, model_eqns, num_fluids, mpp_lim, & & weno_order, bc_x, bc_y, bc_z, num_patches, hypoelasticity, mhd, patch_icpp, fluid_pp, bub_pp, precision, & & parallel_io, mixlayer_vel_profile, mixlayer_vel_coef, mixlayer_perturb, mixlayer_perturb_nk, mixlayer_perturb_k0, & & pi_fac, perturb_flow, perturb_flow_fluid, perturb_flow_mag, perturb_sph, perturb_sph_fluid, fluid_rho, cyl_coord, & @@ -173,19 +173,19 @@ contains if (file_check) then open (1, FILE=trim(file_loc), form='unformatted', STATUS='old', ACTION='read') - read (1) x_cb(-1:m) + read (1) x%cb(-1:m) close (1) else call s_mpi_abort('File x_cb.dat is missing in ' // trim(t_step_dir) // '. Exiting.') end if - x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2._wp + x%cc(0:m) = (x%cb(0:m) + x%cb(-1:(m - 1)))/2._wp - dx = minval(x_cb(0:m) - x_cb(-1:m - 1)) + dx = minval(x%cb(0:m) - x%cb(-1:m - 1)) if (num_procs > 1) call s_mpi_reduce_min(dx) - x_domain%beg = x_cb(-1) - x_domain%end = x_cb(m) + x_domain%beg = x%cb(-1) + x_domain%end = x%cb(m) if (n > 0) then file_loc = trim(t_step_dir) // '/y_cb.dat' @@ -193,19 +193,19 @@ contains if (file_check) then open (1, FILE=trim(file_loc), form='unformatted', STATUS='old', ACTION='read') - read (1) y_cb(-1:n) + read (1) y%cb(-1:n) close (1) else call s_mpi_abort('File y_cb.dat is missing in ' // trim(t_step_dir) // '. Exiting.') end if - y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2._wp + y%cc(0:n) = (y%cb(0:n) + y%cb(-1:(n - 1)))/2._wp - dy = minval(y_cb(0:n) - y_cb(-1:n - 1)) + dy = minval(y%cb(0:n) - y%cb(-1:n - 1)) if (num_procs > 1) call s_mpi_reduce_min(dy) - y_domain%beg = y_cb(-1) - y_domain%end = y_cb(n) + y_domain%beg = y%cb(-1) + y_domain%end = y%cb(n) if (p > 0) then file_loc = trim(t_step_dir) // '/z_cb.dat' @@ -213,19 +213,19 @@ contains if (file_check) then open (1, FILE=trim(file_loc), form='unformatted', STATUS='old', ACTION='read') - read (1) z_cb(-1:p) + read (1) z%cb(-1:p) close (1) else call s_mpi_abort('File z_cb.dat is missing in ' // trim(t_step_dir) // '. Exiting.') end if - z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2._wp + z%cc(0:p) = (z%cb(0:p) + z%cb(-1:(p - 1)))/2._wp - dz = minval(z_cb(0:p) - z_cb(-1:p - 1)) + dz = minval(z%cb(0:p) - z%cb(-1:p - 1)) if (num_procs > 1) call s_mpi_reduce_min(dz) - z_domain%beg = z_cb(-1) - z_domain%end = z_cb(p) + z_domain%beg = z%cb(-1) + z_domain%end = z%cb(p) end if end if @@ -241,17 +241,17 @@ contains !! coordinate directions and making sure that all of the cell-widths are positively valued impure subroutine s_check_grid_data_files - if (any(x_cb(0:m) - x_cb(-1:m - 1) <= 0._wp)) then + if (any(x%cb(0:m) - x%cb(-1:m - 1) <= 0._wp)) then call s_mpi_abort('x_cb.dat in ' // trim(t_step_dir) // ' contains non-positive cell-spacings. Exiting.') end if if (n > 0) then - if (any(y_cb(0:n) - y_cb(-1:n - 1) <= 0._wp)) then + if (any(y%cb(0:n) - y%cb(-1:n - 1) <= 0._wp)) then call s_mpi_abort('y_cb.dat in ' // trim(t_step_dir) // ' contains non-positive cell-spacings. ' // 'Exiting.') end if if (p > 0) then - if (any(z_cb(0:p) - z_cb(-1:p - 1) <= 0._wp)) then + if (any(z%cb(0:p) - z%cb(-1:p - 1) <= 0._wp)) then call s_mpi_abort('z_cb.dat in ' // trim(t_step_dir) // ' contains non-positive cell-spacings' // ' .Exiting.') end if end if @@ -352,12 +352,12 @@ contains call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ') end if - x_cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) - x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2._wp - dx = minval(x_cb(0:m) - x_cb(-1:(m - 1))) + x%cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) + x%cc(0:m) = (x%cb(0:m) + x%cb(-1:(m - 1)))/2._wp + dx = minval(x%cb(0:m) - x%cb(-1:(m - 1))) if (num_procs > 1) call s_mpi_reduce_min(dx) - x_domain%beg = x_cb(-1) - x_domain%end = x_cb(m) + x_domain%beg = x%cb(-1) + x_domain%end = x%cb(m) if (n > 0) then file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'y_cb.dat' @@ -372,12 +372,12 @@ contains call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ') end if - y_cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) - y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2._wp - dy = minval(y_cb(0:n) - y_cb(-1:(n - 1))) + y%cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) + y%cc(0:n) = (y%cb(0:n) + y%cb(-1:(n - 1)))/2._wp + dy = minval(y%cb(0:n) - y%cb(-1:(n - 1))) if (num_procs > 1) call s_mpi_reduce_min(dy) - y_domain%beg = y_cb(-1) - y_domain%end = y_cb(n) + y_domain%beg = y%cb(-1) + y_domain%end = y%cb(n) if (p > 0) then file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'z_cb.dat' @@ -392,12 +392,12 @@ contains call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ') end if - z_cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) - z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2._wp - dz = minval(z_cb(0:p) - z_cb(-1:(p - 1))) + z%cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) + z%cc(0:p) = (z%cb(0:p) + z%cb(-1:(p - 1)))/2._wp + dz = minval(z%cb(0:p) - z%cb(-1:(p - 1))) if (num_procs > 1) call s_mpi_reduce_min(dz) - z_domain%beg = z_cb(-1) - z_domain%end = z_cb(p) + z_domain%beg = z%cb(-1) + z_domain%end = z%cb(p) end if end if @@ -551,9 +551,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - r2 = x_cc(j)**2 - if (n > 0) r2 = r2 + y_cc(k)**2 - if (p > 0) r2 = r2 + z_cc(l)**2 + r2 = x%cc(j)**2 + if (n > 0) r2 = r2 + y%cc(k)**2 + if (p > 0) r2 = r2 + z%cc(l)**2 q_cons_vf(eqn_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2)) q_prim_vf(eqn_idx%psi)%sf(j, k, l) = q_cons_vf(eqn_idx%psi)%sf(j, k, l) end do diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 9b2a969aa4..01806dd78f 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -69,8 +69,7 @@ contains & gauss_sigma_dist(1:num_source), gauss_sigma_time(1:num_source), foc_length(1:num_source), & & aperture(1:num_source), npulse(1:num_source), pulse(1:num_source), dir(1:num_source), delay(1:num_source), & & element_polygon_ratio(1:num_source), rotate_angle(1:num_source), element_spacing_angle(1:num_source), & - & num_elements(1:num_source), element_on(1:num_source), bb_num_freq(1:num_source), bb_bandwidth(1:num_source), & - & bb_lowest_freq(1:num_source)) + & num_elements(1:num_source), element_on(1:num_source), bb_num_freq(1:num_source), bb_bandwidth(1:num_source), bb_lowest_freq(1:num_source)) do i = 1, num_source do j = 1, 3 @@ -487,18 +486,18 @@ contains ! Calculate sig spatial support width if (n == 0) then - sig = dx(j) + sig = x%spacing(j) else if (p == 0) then - sig = maxval((/dx(j), dy(k)/)) + sig = maxval((/x%spacing(j), y%spacing(k)/)) else - sig = maxval((/dx(j), dy(k), dz(l)/)) + sig = maxval((/x%spacing(j), y%spacing(k), z%spacing(l)/)) end if sig = sig*acoustic_spatial_support_width ! Calculate displacement from acoustic source location - r(1) = x_cc(j) - loc(1) - if (n /= 0) r(2) = y_cc(k) - loc(2) - if (p /= 0) r(3) = z_cc(l) - loc(3) + r(1) = x%cc(j) - loc(1) + if (n /= 0) r(2) = y%cc(k) - loc(2) + if (p /= 0) r(3) = z%cc(l) - loc(3) if (any(support(ai) == (/1, 2, 3, 4/))) then call s_source_spatial_planar(ai, sig, r, source) @@ -526,8 +525,8 @@ contains else if (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D ! If we let unit vector e = (cos(dir), sin(dir)), dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e) - if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) & - & then ! |r - dist*e| < length/2 + ! |r - dist*e| < length/2 + if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) then if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp) end if diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index fb5320f09e..abbad139a1 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -45,8 +45,8 @@ contains real(wp), intent(in) :: t #:for DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - if (bf_${XYZ}$) then - accel_bf(${DIR}$) = g_${XYZ}$ + k_${XYZ}$*sin(w_${XYZ}$*t - p_${XYZ}$) + if (bf_${XYZ}$%enabled) then + accel_bf(${DIR}$) = bf_${XYZ}$%g + bf_${XYZ}$%k*sin(bf_${XYZ}$%w*t - bf_${XYZ}$%p) end if #:endfor @@ -98,7 +98,7 @@ contains end do $:END_GPU_PARALLEL_LOOP() - if (bf_x) then ! x-direction body forces + if (bf_x%enabled) then ! x-direction body forces $:GPU_PARALLEL_LOOP(private='[j, k, l]', collapse=3) do l = 0, p @@ -113,7 +113,7 @@ contains $:END_GPU_PARALLEL_LOOP() end if - if (bf_y) then ! y-direction body forces + if (bf_y%enabled) then ! y-direction body forces $:GPU_PARALLEL_LOOP(private='[j, k, l]', collapse=3) do l = 0, p @@ -129,7 +129,7 @@ contains $:END_GPU_PARALLEL_LOOP() end if - if (bf_z) then ! z-direction body forces + if (bf_z%enabled) then ! z-direction body forces $:GPU_PARALLEL_LOOP(private='[j, k, l]', collapse=3) do l = 0, p diff --git a/src/simulation/m_bubbles_EE.fpp b/src/simulation/m_bubbles_EE.fpp index a15156405b..b0461fd976 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -104,7 +104,7 @@ contains do k = 0, n do j = 0, m divu_in%sf(j, k, l) = 0._wp - divu_in%sf(j, k, l) = 5.e-1_wp/dx(j)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j + 1, k, & + divu_in%sf(j, k, l) = 5.e-1_wp/x%spacing(j)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j + 1, k, & & l) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j - 1, k, l)) end do end do @@ -116,8 +116,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - divu_in%sf(j, k, l) = divu_in%sf(j, k, l) + 5.e-1_wp/dy(k)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j, & - & k + 1, l) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k - 1, l)) + divu_in%sf(j, k, l) = divu_in%sf(j, k, & + & l) + 5.e-1_wp/y%spacing(k)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k + 1, & + & l) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k - 1, l)) end do end do end do @@ -127,7 +128,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - divu_in%sf(j, k, l) = divu_in%sf(j, k, l) + 5.e-1_wp/dz(l)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & + divu_in%sf(j, k, l) = divu_in%sf(j, k, & + & l) + 5.e-1_wp/z%spacing(l)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & & l + 1) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, l - 1)) end do end do diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index b44eb617b1..e2d44a1e72 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -202,7 +202,7 @@ contains Rmin_glb = max(dflt_real, -dflt_real) $:GPU_UPDATE(device='[Rmax_glb, Rmin_glb]') - $:GPU_UPDATE(device='[dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc]') + $:GPU_UPDATE(device='[x%spacing, y%spacing, z%spacing, x%cb, x%cc, y%cb, y%cc, z%cb, z%cc]') ! Populate temporal variables call s_transfer_data_to_tmp() @@ -793,48 +793,48 @@ contains !> Getting p_cell in terms of only the current cell by interpolation !> Getting the cell volulme as Omega if (p > 0) then - vol = dx(cell(1))*dy(cell(2))*dz(cell(3)) + vol = x%spacing(cell(1))*y%spacing(cell(2))*z%spacing(cell(3)) else if (cyl_coord) then - vol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi + vol = x%spacing(cell(1))*y%spacing(cell(2))*y%cc(cell(2))*2._wp*pi else - vol = dx(cell(1))*dy(cell(2))*lag_params%charwidth + vol = x%spacing(cell(1))*y%spacing(cell(2))*lag_params%charwidth end if end if !> Obtain bilinear interpolation coefficients, based on the current location of the bubble. - psi(1) = (scoord(1) - real(cell(1)))*dx(cell(1)) + x_cb(cell(1) - 1) + psi(1) = (scoord(1) - real(cell(1)))*x%spacing(cell(1)) + x%cb(cell(1) - 1) if (cell(1) == (m + buff_size)) then cell(1) = cell(1) - 1 psi(1) = 1._wp else if (cell(1) == (-buff_size)) then psi(1) = 0._wp else - if (psi(1) < x_cc(cell(1))) cell(1) = cell(1) - 1 - psi(1) = abs((psi(1) - x_cc(cell(1)))/(x_cc(cell(1) + 1) - x_cc(cell(1)))) + if (psi(1) < x%cc(cell(1))) cell(1) = cell(1) - 1 + psi(1) = abs((psi(1) - x%cc(cell(1)))/(x%cc(cell(1) + 1) - x%cc(cell(1)))) end if - psi(2) = (scoord(2) - real(cell(2)))*dy(cell(2)) + y_cb(cell(2) - 1) + psi(2) = (scoord(2) - real(cell(2)))*y%spacing(cell(2)) + y%cb(cell(2) - 1) if (cell(2) == (n + buff_size)) then cell(2) = cell(2) - 1 psi(2) = 1._wp else if (cell(2) == (-buff_size)) then psi(2) = 0._wp else - if (psi(2) < y_cc(cell(2))) cell(2) = cell(2) - 1 - psi(2) = abs((psi(2) - y_cc(cell(2)))/(y_cc(cell(2) + 1) - y_cc(cell(2)))) + if (psi(2) < y%cc(cell(2))) cell(2) = cell(2) - 1 + psi(2) = abs((psi(2) - y%cc(cell(2)))/(y%cc(cell(2) + 1) - y%cc(cell(2)))) end if if (p > 0) then - psi(3) = (scoord(3) - real(cell(3)))*dz(cell(3)) + z_cb(cell(3) - 1) + psi(3) = (scoord(3) - real(cell(3)))*z%spacing(cell(3)) + z%cb(cell(3) - 1) if (cell(3) == (p + buff_size)) then cell(3) = cell(3) - 1 psi(3) = 1._wp else if (cell(3) == (-buff_size)) then psi(3) = 0._wp else - if (psi(3) < z_cc(cell(3))) cell(3) = cell(3) - 1 - psi(3) = abs((psi(3) - z_cc(cell(3)))/(z_cc(cell(3) + 1) - z_cc(cell(3)))) + if (psi(3) < z%cc(cell(3))) cell(3) = cell(3) - 1 + psi(3) = abs((psi(3) - z%cc(cell(3)))/(z%cc(cell(3) + 1) - z%cc(cell(3)))) end if else psi(3) = 0._wp @@ -890,7 +890,7 @@ contains if ((cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then celloutside = .true. end if - if (cyl_coord .and. y_cc(cellaux(2)) < 0._wp) then + if (cyl_coord .and. y%cc(cellaux(2)) < 0._wp) then celloutside = .true. end if if ((cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then @@ -907,7 +907,7 @@ contains end if end if if (.not. celloutside) then - if (cyl_coord .and. (p == 0) .and. (y_cc(cellaux(2)) < 0._wp)) then + if (cyl_coord .and. (p == 0) .and. (y%cc(cellaux(2)) < 0._wp)) then celloutside = .true. end if end if @@ -915,12 +915,12 @@ contains if (.not. celloutside) then !> Obtaining the cell volulme if (p > 0) then - vol = dx(cellaux(1))*dy(cellaux(2))*dz(cellaux(3)) + vol = x%spacing(cellaux(1))*y%spacing(cellaux(2))*z%spacing(cellaux(3)) else if (cyl_coord) then - vol = dx(cellaux(1))*dy(cellaux(2))*y_cc(cellaux(2))*2._wp*pi + vol = x%spacing(cellaux(1))*y%spacing(cellaux(2))*y%cc(cellaux(2))*2._wp*pi else - vol = dx(cellaux(1))*dy(cellaux(2))*lag_params%charwidth + vol = x%spacing(cellaux(1))*y%spacing(cellaux(2))*lag_params%charwidth end if end if !> Update values @@ -1088,40 +1088,40 @@ contains integer, dimension(3), intent(inout) :: cell integer :: i - do while (pos(1) < x_cb(cell(1) - 1)) + do while (pos(1) < x%cb(cell(1) - 1)) cell(1) = cell(1) - 1 end do - do while (pos(1) > x_cb(cell(1))) + do while (pos(1) > x%cb(cell(1))) cell(1) = cell(1) + 1 end do - do while (pos(2) < y_cb(cell(2) - 1)) + do while (pos(2) < y%cb(cell(2) - 1)) cell(2) = cell(2) - 1 end do - do while (pos(2) > y_cb(cell(2))) + do while (pos(2) > y%cb(cell(2))) cell(2) = cell(2) + 1 end do if (p > 0) then - do while (pos(3) < z_cb(cell(3) - 1)) + do while (pos(3) < z%cb(cell(3) - 1)) cell(3) = cell(3) - 1 end do - do while (pos(3) > z_cb(cell(3))) + do while (pos(3) > z%cb(cell(3))) cell(3) = cell(3) + 1 end do end if ! The numbering of the cell of which left boundary is the domain boundary is 0. if comp.coord of the pos is s, the real ! coordinate of s is (the coordinate of the left boundary of the Floor(s)-th cell) + (s-(int(s))*(cell-width). In other - ! words, the coordinate of the center of the cell is x_cc(cell). + ! words, the coordinate of the center of the cell is x%cc(cell). ! coordinates in computational space - scoord(1) = cell(1) + (pos(1) - x_cb(cell(1) - 1))/dx(cell(1)) - scoord(2) = cell(2) + (pos(2) - y_cb(cell(2) - 1))/dy(cell(2)) + scoord(1) = cell(1) + (pos(1) - x%cb(cell(1) - 1))/x%spacing(cell(1)) + scoord(2) = cell(2) + (pos(2) - y%cb(cell(2) - 1))/y%spacing(cell(2)) scoord(3) = 0._wp - if (p > 0) scoord(3) = cell(3) + (pos(3) - z_cb(cell(3) - 1))/dz(cell(3)) + if (p > 0) scoord(3) = cell(3) + (pos(3) - z%cb(cell(3) - 1))/z%spacing(cell(3)) cell(:) = int(scoord(:)) do i = 1, num_dims if (scoord(i) < 0._wp) cell(i) = cell(i) - 1 @@ -1159,43 +1159,43 @@ contains if (p == 0 .and. cyl_coord .neqv. .true.) then ! Defining a virtual z-axis that has the same dimensions as y-axis defined in the input file - particle_in_domain = ((pos_part(1) < x_cb(m + buff_size)) .and. (pos_part(1) >= x_cb(-buff_size - 1)) & - & .and. (pos_part(2) < y_cb(n + buff_size)) .and. (pos_part(2) >= y_cb(-buff_size - 1)) & + particle_in_domain = ((pos_part(1) < x%cb(m + buff_size)) .and. (pos_part(1) >= x%cb(-buff_size - 1)) & + & .and. (pos_part(2) < y%cb(n + buff_size)) .and. (pos_part(2) >= y%cb(-buff_size - 1)) & & .and. (pos_part(3) < lag_params%charwidth/2._wp) .and. (pos_part(3) >= & & -lag_params%charwidth/2._wp)) else ! cyl_coord - particle_in_domain = ((pos_part(1) < x_cb(m + buff_size)) .and. (pos_part(1) >= x_cb(-buff_size - 1)) & - & .and. (abs(pos_part(2)) < y_cb(n + buff_size)) .and. (abs(pos_part(2)) >= max(y_cb(-buff_size & + particle_in_domain = ((pos_part(1) < x%cb(m + buff_size)) .and. (pos_part(1) >= x%cb(-buff_size - 1)) & + & .and. (abs(pos_part(2)) < y%cb(n + buff_size)) .and. (abs(pos_part(2)) >= max(y%cb(-buff_size & & - 1), 0._wp))) end if ! 3D if (p > 0) then - particle_in_domain = ((pos_part(1) < x_cb(m + buff_size)) .and. (pos_part(1) >= x_cb(-buff_size - 1)) & - & .and. (pos_part(2) < y_cb(n + buff_size)) .and. (pos_part(2) >= y_cb(-buff_size - 1)) & - & .and. (pos_part(3) < z_cb(p + buff_size)) .and. (pos_part(3) >= z_cb(-buff_size - 1))) + particle_in_domain = ((pos_part(1) < x%cb(m + buff_size)) .and. (pos_part(1) >= x%cb(-buff_size - 1)) & + & .and. (pos_part(2) < y%cb(n + buff_size)) .and. (pos_part(2) >= y%cb(-buff_size - 1)) & + & .and. (pos_part(3) < z%cb(p + buff_size)) .and. (pos_part(3) >= z%cb(-buff_size - 1))) end if ! For symmetric and wall boundary condition if (any(bc_x%beg == (/BC_REFLECTIVE, BC_CHAR_SLIP_WALL, BC_SLIP_WALL, BC_NO_SLIP_WALL/))) then - particle_in_domain = (particle_in_domain .and. (pos_part(1) >= x_cb(-1))) + particle_in_domain = (particle_in_domain .and. (pos_part(1) >= x%cb(-1))) end if if (any(bc_x%end == (/BC_REFLECTIVE, BC_CHAR_SLIP_WALL, BC_SLIP_WALL, BC_NO_SLIP_WALL/))) then - particle_in_domain = (particle_in_domain .and. (pos_part(1) < x_cb(m))) + particle_in_domain = (particle_in_domain .and. (pos_part(1) < x%cb(m))) end if if (any(bc_y%beg == (/BC_REFLECTIVE, BC_CHAR_SLIP_WALL, BC_SLIP_WALL, BC_NO_SLIP_WALL/)) .and. (.not. cyl_coord)) then - particle_in_domain = (particle_in_domain .and. (pos_part(2) >= y_cb(-1))) + particle_in_domain = (particle_in_domain .and. (pos_part(2) >= y%cb(-1))) end if if (any(bc_y%end == (/BC_REFLECTIVE, BC_CHAR_SLIP_WALL, BC_SLIP_WALL, BC_NO_SLIP_WALL/)) .and. (.not. cyl_coord)) then - particle_in_domain = (particle_in_domain .and. (pos_part(2) < y_cb(n))) + particle_in_domain = (particle_in_domain .and. (pos_part(2) < y%cb(n))) end if if (p > 0) then if (any(bc_z%beg == (/BC_REFLECTIVE, BC_CHAR_SLIP_WALL, BC_SLIP_WALL, BC_NO_SLIP_WALL/))) then - particle_in_domain = (particle_in_domain .and. (pos_part(3) >= z_cb(-1))) + particle_in_domain = (particle_in_domain .and. (pos_part(3) >= z%cb(-1))) end if if (any(bc_z%end == (/BC_REFLECTIVE, BC_CHAR_SLIP_WALL, BC_SLIP_WALL, BC_NO_SLIP_WALL/))) then - particle_in_domain = (particle_in_domain .and. (pos_part(3) < z_cb(p))) + particle_in_domain = (particle_in_domain .and. (pos_part(3) < z%cb(p))) end if end if @@ -1207,12 +1207,12 @@ contains logical :: particle_in_domain_physical real(wp), dimension(3), intent(in) :: pos_part - particle_in_domain_physical = ((pos_part(1) < x_cb(m)) .and. (pos_part(1) >= x_cb(-1)) .and. (pos_part(2) < y_cb(n)) & - & .and. (pos_part(2) >= y_cb(-1))) + particle_in_domain_physical = ((pos_part(1) < x%cb(m)) .and. (pos_part(1) >= x%cb(-1)) .and. (pos_part(2) < y%cb(n)) & + & .and. (pos_part(2) >= y%cb(-1))) if (p > 0) then - particle_in_domain_physical = (particle_in_domain_physical .and. (pos_part(3) < z_cb(p)) .and. (pos_part(3) & - & >= z_cb(-1))) + particle_in_domain_physical = (particle_in_domain_physical .and. (pos_part(3) < z%cb(p)) .and. (pos_part(3) & + & >= z%cb(-1))) end if end function particle_in_domain_physical @@ -1230,9 +1230,9 @@ contains do k = 0, p do j = 0, n do i = 0, m - dq(i, j, k) = q(i, j, k)*(dx(i + 1) - dx(i - 1)) + q(i + 1, j, k)*(dx(i) + dx(i - 1)) - q(i - 1, j, & - & k)*(dx(i) + dx(i + 1)) - dq(i, j, k) = dq(i, j, k)/((dx(i) + dx(i - 1))*(dx(i) + dx(i + 1))) + dq(i, j, k) = q(i, j, k)*(x%spacing(i + 1) - x%spacing(i - 1)) + q(i + 1, j, & + & k)*(x%spacing(i) + x%spacing(i - 1)) - q(i - 1, j, k)*(x%spacing(i) + x%spacing(i + 1)) + dq(i, j, k) = dq(i, j, k)/((x%spacing(i) + x%spacing(i - 1))*(x%spacing(i) + x%spacing(i + 1))) end do end do end do @@ -1243,9 +1243,9 @@ contains do k = 0, p do j = 0, n do i = 0, m - dq(i, j, k) = q(i, j, k)*(dy(j + 1) - dy(j - 1)) + q(i, j + 1, k)*(dy(j) + dy(j - 1)) - q(i, j - 1, & - & k)*(dy(j) + dy(j + 1)) - dq(i, j, k) = dq(i, j, k)/((dy(j) + dy(j - 1))*(dy(j) + dy(j + 1))) + dq(i, j, k) = q(i, j, k)*(y%spacing(j + 1) - y%spacing(j - 1)) + q(i, j + 1, & + & k)*(y%spacing(j) + y%spacing(j - 1)) - q(i, j - 1, k)*(y%spacing(j) + y%spacing(j + 1)) + dq(i, j, k) = dq(i, j, k)/((y%spacing(j) + y%spacing(j - 1))*(y%spacing(j) + y%spacing(j + 1))) end do end do end do @@ -1256,9 +1256,9 @@ contains do k = 0, p do j = 0, n do i = 0, m - dq(i, j, k) = q(i, j, k)*(dz(k + 1) - dz(k - 1)) + q(i, j, k + 1)*(dz(k) + dz(k - 1)) - q(i, j, & - & k - 1)*(dz(k) + dz(k + 1)) - dq(i, j, k) = dq(i, j, k)/((dz(k) + dz(k - 1))*(dz(k) + dz(k + 1))) + dq(i, j, k) = q(i, j, k)*(z%spacing(k + 1) - z%spacing(k - 1)) + q(i, j, & + & k + 1)*(z%spacing(k) + z%spacing(k - 1)) - q(i, j, k - 1)*(z%spacing(k) + z%spacing(k + 1)) + dq(i, j, k) = dq(i, j, k)/((z%spacing(k) + z%spacing(k - 1))*(z%spacing(k) + z%spacing(k + 1))) end do end do end do diff --git a/src/simulation/m_bubbles_EL_kernels.fpp b/src/simulation/m_bubbles_EL_kernels.fpp index f1f80980b0..1f754e990f 100644 --- a/src/simulation/m_bubbles_EL_kernels.fpp +++ b/src/simulation/m_bubbles_EL_kernels.fpp @@ -54,10 +54,10 @@ contains strength_vel = 4._wp*pi*lbk_rad(l, 2)**2._wp*lbk_vel(l, 2) if (num_dims == 2) then - Vol = dx(cell(1))*dy(cell(2))*lag_params%charwidth - if (cyl_coord) Vol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi + Vol = x%spacing(cell(1))*y%spacing(cell(2))*lag_params%charwidth + if (cyl_coord) Vol = x%spacing(cell(1))*y%spacing(cell(2))*y%cc(cell(2))*2._wp*pi else - Vol = dx(cell(1))*dy(cell(2))*dz(cell(3)) + Vol = x%spacing(cell(1))*y%spacing(cell(2))*z%spacing(cell(3)) end if ! Update void fraction field @@ -133,9 +133,9 @@ contains call s_check_celloutside(cellaux, celloutside) if (.not. celloutside) then - nodecoord(1) = x_cc(cellaux(1)) - nodecoord(2) = y_cc(cellaux(2)) - if (p > 0) nodecoord(3) = z_cc(cellaux(3)) + nodecoord(1) = x%cc(cellaux(1)) + nodecoord(2) = y%cc(cellaux(2)) + if (p > 0) nodecoord(3) = z%cc(cellaux(3)) call s_applygaussian(center, cellaux, nodecoord, stddsv, 0._wp, func) if (lag_params%cluster_type >= 4) call s_applygaussian(center, cellaux, nodecoord, stddsv, 1._wp, func2) @@ -204,7 +204,7 @@ contains !> 2D cylindrical function: ! We smear particles in the azimuthal direction for given r theta = 0._wp - Nr = ceiling(2._wp*pi*nodecoord(2)/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1))) + Nr = ceiling(2._wp*pi*nodecoord(2)/(y%cb(cellaux(2)) - y%cb(cellaux(2) - 1))) dtheta = 2._wp*pi/Nr L2 = center(2)**2._wp + nodecoord(2)**2._wp - 2._wp*center(2)*nodecoord(2)*cos(theta) distance = sqrt((center(1) - nodecoord(1))**2._wp + L2) @@ -225,9 +225,9 @@ contains !> 2D cartesian function: ! We smear particles considering a virtual depth (lag_params%charwidth) theta = 0._wp - Nr = ceiling(lag_params%charwidth/(y_cb(cellaux(2)) - y_cb(cellaux(2) - 1))) + Nr = ceiling(lag_params%charwidth/(y%cb(cellaux(2)) - y%cb(cellaux(2) - 1))) Nr_count = 1._wp - mapCells*1._wp - dzp = y_cb(cellaux(2) + 1) - y_cb(cellaux(2)) + dzp = y%cb(cellaux(2) + 1) - y%cb(cellaux(2)) Lz2 = (center(3) - (dzp*(0.5_wp + Nr_count) - lag_params%charwidth/2._wp))**2._wp distance = sqrt((center(1) - nodecoord(1))**2._wp + (center(2) - nodecoord(2))**2._wp + Lz2) func = dzp/lag_params%charwidth*exp(-0.5_wp*(distance/stddsv)**2._wp)/(sqrt(2._wp*pi)*stddsv)**3._wp @@ -257,7 +257,7 @@ contains if ((cellaux(1) < -buff_size) .or. (cellaux(2) < -buff_size)) then celloutside = .true. end if - if (cyl_coord .and. y_cc(cellaux(2)) < 0._wp) then + if (cyl_coord .and. y%cc(cellaux(2)) < 0._wp) then celloutside = .true. end if if ((cellaux(2) > n + buff_size) .or. (cellaux(1) > m + buff_size)) then @@ -323,17 +323,17 @@ contains real(wp) :: rad !> Compute characteristic distance - chardist = sqrt(dx(cell(1))*dy(cell(2))) - if (p > 0) chardist = (dx(cell(1))*dy(cell(2))*dz(cell(3)))**(1._wp/3._wp) + chardist = sqrt(x%spacing(cell(1))*y%spacing(cell(2))) + if (p > 0) chardist = (x%spacing(cell(1))*y%spacing(cell(2))*z%spacing(cell(3)))**(1._wp/3._wp) !> Compute characteristic volume if (p > 0) then - charvol = dx(cell(1))*dy(cell(2))*dz(cell(3)) + charvol = x%spacing(cell(1))*y%spacing(cell(2))*z%spacing(cell(3)) else if (cyl_coord) then - charvol = dx(cell(1))*dy(cell(2))*y_cc(cell(2))*2._wp*pi + charvol = x%spacing(cell(1))*y%spacing(cell(2))*y%cc(cell(2))*2._wp*pi else - charvol = dx(cell(1))*dy(cell(2))*lag_params%charwidth + charvol = x%spacing(cell(1))*y%spacing(cell(2))*lag_params%charwidth end if end if @@ -356,12 +356,12 @@ contains real(wp), intent(out) :: Charvol if (p > 0) then - Charvol = dx(cellx)*dy(celly)*dz(cellz) + Charvol = x%spacing(cellx)*y%spacing(celly)*z%spacing(cellz) else if (cyl_coord) then - Charvol = dx(cellx)*dy(celly)*y_cc(celly)*2._wp*pi + Charvol = x%spacing(cellx)*y%spacing(celly)*y%cc(celly)*2._wp*pi else - Charvol = dx(cellx)*dy(celly)*lag_params%charwidth + Charvol = x%spacing(cellx)*y%spacing(celly)*lag_params%charwidth end if end if diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index d703a3c1e3..565ca6c9b6 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -312,8 +312,8 @@ contains vel_out(${CBC_DIR}$, 3) = bc_${XYZ}$%vel_out(3) end if end if - Del_in(${CBC_DIR}$) = maxval(d${XYZ}$) - Del_out(${CBC_DIR}$) = maxval(d${XYZ}$) + Del_in(${CBC_DIR}$) = maxval(${XYZ}$%spacing) + Del_out(${CBC_DIR}$) = maxval(${XYZ}$%spacing) pres_in(${CBC_DIR}$) = bc_${XYZ}$%pres_in pres_out(${CBC_DIR}$) = bc_${XYZ}$%pres_out do i = 1, num_fluids @@ -422,11 +422,11 @@ contains if (cbc_loc_in == -1) then do i = 0, buff_size - ds(i) = dx(i) + ds(i) = x%spacing(i) end do else do i = 0, buff_size - ds(i) = dx(m - i) + ds(i) = x%spacing(m - i) end do end if @@ -436,11 +436,11 @@ contains if (cbc_loc_in == -1) then do i = 0, buff_size - ds(i) = dy(i) + ds(i) = y%spacing(i) end do else do i = 0, buff_size - ds(i) = dy(n - i) + ds(i) = y%spacing(n - i) end do end if @@ -450,11 +450,11 @@ contains if (cbc_loc_in == -1) then do i = 0, buff_size - ds(i) = dz(i) + ds(i) = z%spacing(i) end do else do i = 0, buff_size - ds(i) = dz(p - i) + ds(i) = z%spacing(p - i) end do end if end if @@ -725,15 +725,15 @@ contains Ma = vel(dir_idx(1))/c - if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SLIP_WALL) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_SLIP_WALL)) then + if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SLIP_WALL) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_SLIP_WALL)) then call s_compute_slip_wall_L(lambda, L, rho, c, dpres_ds, dvel_ds) - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_BUFFER) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_BUFFER)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_BUFFER) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_BUFFER)) then call s_compute_nonreflecting_subsonic_buffer_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, & & dvel_ds, dadv_ds, dYs_ds) - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_INFLOW) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_INFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_INFLOW) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_INFLOW)) then call s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, dpres_ds, dvel_ds) ! Add GRCBC for Subsonic Inflow if (bc_${XYZ}$%grcbc_in) then @@ -759,8 +759,8 @@ contains & dir_idx(1))*sign(1, & & cbc_loc))/Del_in(${CBC_DIR}$) + c*(1._wp + Ma)*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) end if - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_OUTFLOW) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_OUTFLOW)) then call s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, & & dvel_ds, dadv_ds, dYs_ds) ! Add GRCBC for Subsonic Outflow (Pressure) @@ -773,26 +773,26 @@ contains & + vel_out(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_out(${CBC_DIR}$) end if end if - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_FF_SUB_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_FF_SUB_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_FF_SUB_OUTFLOW) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_FF_SUB_OUTFLOW)) then call s_compute_force_free_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, & & dadv_ds) - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_CP_SUB_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_CP_SUB_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_CP_SUB_OUTFLOW) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_CP_SUB_OUTFLOW)) then call s_compute_constant_pressure_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, & & dvel_ds, dadv_ds) - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SUP_INFLOW) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_SUP_INFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SUP_INFLOW) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_SUP_INFLOW)) then call s_compute_supersonic_inflow_L(L) - else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SUP_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_SUP_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SUP_OUTFLOW) .or. (cbc_loc == 1 & + & .and. bc_${XYZ}$%end == BC_CHAR_SUP_OUTFLOW)) then call s_compute_supersonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, & & dYs_ds) end if ! Be careful about the cylindrical coordinate! if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then - dpres_dt = -5.e-1_wp*(L(eqn_idx%adv%end) + L(1)) + rho*c*c*vel(dir_idx(1))/y_cc(n) + dpres_dt = -5.e-1_wp*(L(eqn_idx%adv%end) + L(1)) + rho*c*c*vel(dir_idx(1))/y%cc(n) else dpres_dt = -5.e-1_wp*(L(eqn_idx%adv%end) + L(1)) end if @@ -825,7 +825,7 @@ contains if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, eqn_idx%adv%end - eqn_idx%E - dadv_dt(i) = -L(eqn_idx%mom%end + i) ! + adv_local(i) * vel(dir_idx(1))/y_cc(n) + dadv_dt(i) = -L(eqn_idx%mom%end + i) ! + adv_local(i) * vel(dir_idx(1))/y%cc(n) end do else $:GPU_LOOP(parallelism='[seq]') diff --git a/src/simulation/m_collisions.fpp b/src/simulation/m_collisions.fpp index fe860cb055..cb23dd67e4 100644 --- a/src/simulation/m_collisions.fpp +++ b/src/simulation/m_collisions.fpp @@ -426,10 +426,10 @@ contains #:endfor ! the object that contains the collision location owns the collisions - owns_collision = x_cb(-1) <= projected_location(1) .and. projected_location(1) < x_cb(m) - owns_collision = owns_collision .and. y_cb(-1) <= projected_location(2) .and. projected_location(2) < y_cb(n) - if (num_dims == 3) owns_collision = owns_collision .and. z_cb(-1) <= projected_location(3) & - & .and. projected_location(3) < z_cb(p) + owns_collision = x%cb(-1) <= projected_location(1) .and. projected_location(1) < x%cb(m) + owns_collision = owns_collision .and. y%cb(-1) <= projected_location(2) .and. projected_location(2) < y%cb(n) + if (num_dims == 3) owns_collision = owns_collision .and. z%cb(-1) <= projected_location(3) & + & .and. projected_location(3) < z%cb(p) end if #:else owns_collision = .true. diff --git a/src/simulation/m_compute_levelset.fpp b/src/simulation/m_compute_levelset.fpp index 96fdebb357..d5bc11447b 100644 --- a/src/simulation/m_compute_levelset.fpp +++ b/src/simulation/m_compute_levelset.fpp @@ -88,8 +88,8 @@ contains radius = patch_ib(ib_patch_id)%radius - dist_vec(1) = x_cc(i) - patch_ib(ib_patch_id)%x_centroid - real(gp%x_periodicity, wp)*(x_domain%end - x_domain%beg) - dist_vec(2) = y_cc(j) - patch_ib(ib_patch_id)%y_centroid - real(gp%y_periodicity, wp)*(y_domain%end - y_domain%beg) + dist_vec(1) = x%cc(i) - patch_ib(ib_patch_id)%x_centroid - real(gp%x_periodicity, wp)*(x_domain%end - x_domain%beg) + dist_vec(2) = y%cc(j) - patch_ib(ib_patch_id)%y_centroid - real(gp%y_periodicity, wp)*(y_domain%end - y_domain%beg) dist_vec(3) = 0._wp dist = sqrt(sum(dist_vec**2)) @@ -125,7 +125,7 @@ contains rotation(:,:) = patch_ib(ib_patch_id)%rotation_matrix(:,:) offset(:) = patch_ib(ib_patch_id)%centroid_offset(:) - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] ! get coordinate frame centered on IB + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] ! get coordinate frame centered on IB xy_local = matmul(inverse_rotation, xy_local) ! rotate the frame into the IB's coordinate xy_local = xy_local - offset ! airfoils are a patch that require a centroid offset @@ -210,7 +210,7 @@ contains z_max = lz/2 z_min = -lz/2 - xyz_local = [x_cc(i), y_cc(j), z_cc(l)] - center + xyz_local = [x%cc(i), y%cc(j), z%cc(l)] - center xyz_local = matmul(inverse_rotation, xyz_local) ! rotate the frame into the IB's coordinates xyz_local = xyz_local - offset ! airfoils are a patch that require a centroid offset @@ -311,7 +311,7 @@ contains bottom_left(2) = -length_y/2 ! convert grid to local coordinates - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] xy_local = matmul(inverse_rotation, xy_local) side_dists(1) = bottom_left(1) - xy_local(1) @@ -374,12 +374,12 @@ contains ellipse_coeffs(1) = 0.5_wp*length_x ellipse_coeffs(2) = 0.5_wp*length_y - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] xy_local = matmul(inverse_rotation, xy_local) normal_vector = xy_local - normal_vector(2) = normal_vector(2)*(ellipse_coeffs(1)/ellipse_coeffs(2)) & - & **2._wp ! get the normal direction via the coordinate transformation method + ! get the normal direction via the coordinate transformation method + normal_vector(2) = normal_vector(2)*(ellipse_coeffs(1)/ellipse_coeffs(2))**2._wp normal_vector = normal_vector/sqrt(dot_product(normal_vector, normal_vector)) ! normalize the vector gp%levelset_norm = matmul(rotation, normal_vector) ! save after rotating the vector to the global frame @@ -433,7 +433,7 @@ contains Front = length_z/2 Back = -length_z/2 - xyz_local = [x_cc(i), y_cc(j), z_cc(k)] - center ! get coordinate frame centered on IB + xyz_local = [x%cc(i), y%cc(j), z%cc(k)] - center ! get coordinate frame centered on IB xyz_local = matmul(inverse_rotation, xyz_local) ! rotate the frame into the IB's coordinate dist_left = Left - xyz_local(1) @@ -505,9 +505,9 @@ contains center(3) = patch_ib(ib_patch_id)%z_centroid center = center + periodicity - dist_vec(1) = x_cc(i) - center(1) - dist_vec(2) = y_cc(j) - center(2) - dist_vec(3) = z_cc(k) - center(3) + dist_vec(1) = x%cc(i) - center(1) + dist_vec(2) = y%cc(j) - center(2) + dist_vec(3) = z%cc(k) - center(3) dist = sqrt(sum(dist_vec**2)) gp%levelset = dist - radius if (f_approx_equal(dist, 0._wp)) then @@ -566,7 +566,7 @@ contains dist_surface_vec = (/1, 1, 0/) end if - xyz_local = [x_cc(i), y_cc(j), z_cc(k)] - center ! get coordinate frame centered on IB + xyz_local = [x%cc(i), y%cc(j), z%cc(k)] - center ! get coordinate frame centered on IB xyz_local = matmul(inverse_rotation, xyz_local) ! rotate the frame into the IB's coordinates ! get distance to flat edge of cylinder @@ -626,9 +626,9 @@ contains rotation(:,:) = patch_ib(patch_id)%rotation_matrix(:,:) ! determine where we are located in space - xyz_local = (/x_cc(i) - center(1), y_cc(j) - center(2), 0._wp/) + xyz_local = (/x%cc(i) - center(1), y%cc(j) - center(2), 0._wp/) if (p > 0) then - xyz_local(3) = z_cc(k) - center(3) + xyz_local(3) = z%cc(k) - center(3) end if xyz_local = matmul(inverse_rotation, xyz_local) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index a5fdb3ef81..02235fac99 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -301,19 +301,19 @@ contains file_path = trim(t_step_dir) // '/x_cb.dat' open (2, FILE=trim(file_path), form='unformatted', STATUS='new') - write (2) x_cb(-1:m); close (2) + write (2) x%cb(-1:m); close (2) if (n > 0) then file_path = trim(t_step_dir) // '/y_cb.dat' open (2, FILE=trim(file_path), form='unformatted', STATUS='new') - write (2) y_cb(-1:n); close (2) + write (2) y%cb(-1:n); close (2) if (p > 0) then file_path = trim(t_step_dir) // '/z_cb.dat' open (2, FILE=trim(file_path), form='unformatted', STATUS='new') - write (2) z_cb(-1:p); close (2) + write (2) z%cb(-1:p); close (2) end if end if @@ -401,9 +401,9 @@ contains do j = 0, m ! todo: revisit change here if (((i >= eqn_idx%adv%beg) .and. (i <= eqn_idx%adv%end))) then - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0) else - write (2, FMT) x_cb(j), q_prim_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_prim_vf(i)%sf(j, 0, 0) end if end do close (2) @@ -415,7 +415,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m - write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) + write (2, FMT) x%cb(j), q_cons_vf(i)%sf(j, 0, 0) end do close (2) end do @@ -428,7 +428,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m - write (2, FMT) x_cb(j), pb_ts(1)%sf(j, 0, 0, r, i) + write (2, FMT) x%cb(j), pb_ts(1)%sf(j, 0, 0, r, i) end do close (2) end do @@ -440,7 +440,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m - write (2, FMT) x_cb(j), mv_ts(1)%sf(j, 0, 0, r, i) + write (2, FMT) x%cb(j), mv_ts(1)%sf(j, 0, 0, r, i) end do close (2) end do @@ -460,7 +460,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), q_cons_vf(i)%sf(j, k, 0) + write (2, FMT) x%cb(j), y%cb(k), q_cons_vf(i)%sf(j, k, 0) end do write (2, *) end do @@ -472,7 +472,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), beta%sf(j, k, 0) + write (2, FMT) x%cb(j), y%cb(k), beta%sf(j, k, 0) end do write (2, *) end do @@ -488,7 +488,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), pb_ts(1)%sf(j, k, 0, r, i) + write (2, FMT) x%cb(j), y%cb(k), pb_ts(1)%sf(j, k, 0, r, i) end do end do close (2) @@ -502,7 +502,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m do k = 0, n - write (2, FMT) x_cb(j), y_cb(k), mv_ts(1)%sf(j, k, 0, r, i) + write (2, FMT) x%cb(j), y%cb(k), mv_ts(1)%sf(j, k, 0, r, i) end do end do close (2) @@ -520,9 +520,9 @@ contains do k = 0, n if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & & .and. (i <= eqn_idx%adv%end))) then - write (2, FMT) x_cb(j), y_cb(k), q_cons_vf(i)%sf(j, k, 0) + write (2, FMT) x%cb(j), y%cb(k), q_cons_vf(i)%sf(j, k, 0) else - write (2, FMT) x_cb(j), y_cb(k), q_prim_vf(i)%sf(j, k, 0) + write (2, FMT) x%cb(j), y%cb(k), q_prim_vf(i)%sf(j, k, 0) end if end do write (2, *) @@ -545,7 +545,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), q_cons_vf(i)%sf(j, k, l) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), q_cons_vf(i)%sf(j, k, l) end do write (2, *) end do @@ -560,7 +560,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), beta%sf(j, k, l) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), beta%sf(j, k, l) end do write (2, *) end do @@ -579,7 +579,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), pb_ts(1)%sf(j, k, l, r, i) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), pb_ts(1)%sf(j, k, l, r, i) end do end do end do @@ -595,7 +595,7 @@ contains do j = 0, m do k = 0, n do l = 0, p - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), mv_ts(1)%sf(j, k, l, r, i) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), mv_ts(1)%sf(j, k, l, r, i) end do end do end do @@ -616,9 +616,9 @@ contains if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & & .and. (i <= eqn_idx%adv%end)) .or. ((i >= eqn_idx%species%beg) & & .and. (i <= eqn_idx%species%end))) then - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), q_cons_vf(i)%sf(j, k, l) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), q_cons_vf(i)%sf(j, k, l) else - write (2, FMT) x_cb(j), y_cb(k), z_cb(l), q_prim_vf(i)%sf(j, k, l) + write (2, FMT) x%cb(j), y%cb(k), z%cb(l), q_prim_vf(i)%sf(j, k, l) end if end do write (2, *) @@ -1136,9 +1136,9 @@ contains damage_state = 0._wp if (n == 0) then - if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then + if ((probe(i)%x >= x%cb(-1)) .and. (probe(i)%x <= x%cb(m))) then do s = -1, m - distx(s) = x_cb(s) - probe(i)%x + distx(s) = x%cb(s) - probe(i)%x if (distx(s) < 0._wp) distx(s) = 1000._wp end do j = minloc(distx, 1) @@ -1244,14 +1244,14 @@ contains end do end if - if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then - if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then + if ((probe(i)%x >= x%cb(-1)) .and. (probe(i)%x <= x%cb(m))) then + if ((probe(i)%y >= y%cb(-1)) .and. (probe(i)%y <= y%cb(n))) then do s = -1, m - distx(s) = x_cb(s) - probe(i)%x + distx(s) = x%cb(s) - probe(i)%x if (distx(s) < 0._wp) distx(s) = 1000._wp end do do s = -1, n - disty(s) = y_cb(s) - probe(i)%y + disty(s) = y%cb(s) - probe(i)%y if (disty(s) < 0._wp) disty(s) = 1000._wp end do j = minloc(distx, 1) @@ -1319,19 +1319,19 @@ contains end if end if else - if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then - if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then - if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then + if ((probe(i)%x >= x%cb(-1)) .and. (probe(i)%x <= x%cb(m))) then + if ((probe(i)%y >= y%cb(-1)) .and. (probe(i)%y <= y%cb(n))) then + if ((probe(i)%z >= z%cb(-1)) .and. (probe(i)%z <= z%cb(p))) then do s = -1, m - distx(s) = x_cb(s) - probe(i)%x + distx(s) = x%cb(s) - probe(i)%x if (distx(s) < 0._wp) distx(s) = 1000._wp end do do s = -1, n - disty(s) = y_cb(s) - probe(i)%y + disty(s) = y%cb(s) - probe(i)%y if (disty(s) < 0._wp) disty(s) = 1000._wp end do do s = -1, p - distz(s) = z_cb(s) - probe(i)%z + distz(s) = z%cb(s) - probe(i)%z if (distz(s) < 0._wp) distz(s) = 1000._wp end do j = minloc(distx, 1) @@ -1485,7 +1485,7 @@ contains pi_inf = 0._wp qv = 0._wp - if ((integral(i)%xmin <= x_cb(j)) .and. (integral(i)%xmax >= x_cb(j))) then + if ((integral(i)%xmin <= x%cb(j)) .and. (integral(i)%xmax >= x%cb(j))) then npts = npts + 1 call s_convert_to_mixture_variables(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv, Re) do s = 1, num_vels @@ -1528,14 +1528,14 @@ contains trigger = .false. if (i == 1) then ! inner portion - if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) trigger = .true. + if (sqrt(x%cb(j)**2._wp + y%cb(k)**2._wp) < (rad - 0.5_wp*thickness)) trigger = .true. else if (i == 2) then ! net region - if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. sqrt(x_cb(j)**2._wp & - & + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) trigger = .true. + if (sqrt(x%cb(j)**2._wp + y%cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. sqrt(x%cb(j)**2._wp & + & + y%cb(k)**2._wp) < (rad + 0.5_wp*thickness)) trigger = .true. else if (i == 3) then ! everything else - if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) trigger = .true. + if (sqrt(x%cb(j)**2._wp + y%cb(k)**2._wp) > (rad + 0.5_wp*thickness)) trigger = .true. end if pres = 0._wp diff --git a/src/simulation/m_derived_variables.fpp b/src/simulation/m_derived_variables.fpp index 22c0477065..287d046489 100644 --- a/src/simulation/m_derived_variables.fpp +++ b/src/simulation/m_derived_variables.fpp @@ -81,15 +81,15 @@ contains call s_open_com_files() end if ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(m, x%cc, fd_coeff_x, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_x]') if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(n, y%cc, fd_coeff_y, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_y]') end if if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(p, z%cc, fd_coeff_z, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_z]') end if end if @@ -205,7 +205,7 @@ contains & j)*q_prim_vf0(eqn_idx%mom%beg)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, & & k, l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, r + k, & & l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)*fd_coeff_z(r, & - & l)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, r + l)/y_cc(k) + & l)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, r + l)/y%cc(k) end do end do end do @@ -270,7 +270,7 @@ contains & l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, l)*fd_coeff_y(r, & & k)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, r + k, l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, & & k, l)*fd_coeff_z(r, l)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, & - & r + l)/y_cc(k) - (q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)**2._wp)/y_cc(k) + & r + l)/y%cc(k) - (q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)**2._wp)/y%cc(k) end do end do end do @@ -319,8 +319,8 @@ contains & l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%end)%sf(j, r + k, & & l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)*fd_coeff_z(r, & & l)*q_prim_vf0(eqn_idx%mom%end)%sf(j, k, & - & r + l)/y_cc(k) + (q_prim_vf0(eqn_idx%mom%end)%sf(j, k, & - & l)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, l))/y_cc(k) + & r + l)/y%cc(k) + (q_prim_vf0(eqn_idx%mom%end)%sf(j, k, & + & l)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, l))/y%cc(k) end do end do end do @@ -367,13 +367,13 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! Loop over individual fluids - dV = dx(j) + dV = x%spacing(j) ! Mass $:GPU_ATOMIC(atomic='update') c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ! x-location weighted $:GPU_ATOMIC(atomic='update') - c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) + c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x%cc(j) ! Volume fraction $:GPU_ATOMIC(atomic='update') c_m(i, 5) = c_m(i, 5) + q_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*dV @@ -389,16 +389,16 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! Loop over individual fluids - dV = dx(j)*dy(k) + dV = x%spacing(j)*y%spacing(k) ! Mass $:GPU_ATOMIC(atomic='update') c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ! x-location weighted $:GPU_ATOMIC(atomic='update') - c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) + c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x%cc(j) ! y-location weighted $:GPU_ATOMIC(atomic='update') - c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) + c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y%cc(k) ! Volume fraction $:GPU_ATOMIC(atomic='update') c_m(i, 5) = c_m(i, 5) + q_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*dV @@ -414,19 +414,19 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! Loop over individual fluids - dV = dx(j)*dy(k)*dz(l) + dV = x%spacing(j)*y%spacing(k)*z%spacing(l) ! Mass $:GPU_ATOMIC(atomic='update') c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ! x-location weighted $:GPU_ATOMIC(atomic='update') - c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) + c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x%cc(j) ! y-location weighted $:GPU_ATOMIC(atomic='update') - c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) + c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y%cc(k) ! z-location weighted $:GPU_ATOMIC(atomic='update') - c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) + c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z%cc(l) ! Volume fraction $:GPU_ATOMIC(atomic='update') c_m(i, 5) = c_m(i, 5) + q_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*dV diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 8842759cbe..23bc64a09d 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -48,23 +48,17 @@ module m_global_parameters !> @} $:GPU_DECLARE(create='[cyl_coord, grid_geometry]') - !> @name Cell-boundary (CB) locations in the x-, y- and z-directions, respectively + !> @name Cell-boundary (cb), cell-center (cc), and spacing arrays per direction !> @{ - real(wp), target, allocatable, dimension(:) :: x_cb, y_cb, z_cb - !> @} - - !> @name Cell-center (CC) locations in the x-, y- and z-directions, respectively - !> @{ - real(wp), target, allocatable, dimension(:) :: x_cc, y_cc, z_cc - !> @} - ! type(bounds_info) :: x_domain, y_domain, z_domain !< Locations of the domain bounds in the x-, y- and z-coordinate directions - !> @name Cell-width distributions in the x-, y- and z-directions, respectively - !> @{ - real(wp), target, allocatable, dimension(:) :: dx, dy, dz + type(grid_axis), target :: x, y, z !> @} real(wp) :: dt !< Size of the time-step - $:GPU_DECLARE(create='[x_cb, y_cb, z_cb, x_cc, y_cc, z_cc, dx, dy, dz, dt, m, n, p]') +#if defined(MFC_OpenACC) + $:GPU_DECLARE(create='[x%cb, y%cb, z%cb, x%cc, y%cc, z%cc, x%spacing, y%spacing, z%spacing, dt, m, n, p]') +#elif defined(MFC_OpenMP) + $:GPU_DECLARE(create='[x, y, z, dt, m, n, p]') +#endif !> @name Starting time-step iteration, stopping time-step iteration and the number of time-step iterations between successive !! solution backups, respectively @@ -167,27 +161,20 @@ module m_global_parameters real(wp) :: ic_eps !< THINC Epsilon to compress on surface cells real(wp) :: ic_beta !< THINC Sharpness Parameter $:GPU_DECLARE(create='[int_comp, ic_eps, ic_beta]') - integer :: hyper_model !< hyperelasticity solver algorithm - logical :: elasticity !< elasticity modeling, true for hyper or hypo - logical, parameter :: chemistry = .${chemistry}$. !< Chemistry modeling - logical :: shear_stress !< Shear stresses - logical :: bulk_stress !< Bulk stresses - logical :: cont_damage !< Continuum damage modeling - logical :: hyper_cleaning !< Hyperbolic cleaning for MHD for divB=0 - integer :: num_igr_iters !< number of iterations for elliptic solve - integer :: num_igr_warm_start_iters !< number of warm start iterations for elliptic solve - real(wp) :: alf_factor !< alpha factor for IGR - logical :: bodyForces - logical :: bf_x, bf_y, bf_z !< body force toggle in three directions - !> amplitude, frequency, and phase shift sinusoid in each direction - #:for dir in {'x', 'y', 'z'} - #:for param in {'k','w','p','g'} - real(wp) :: ${param}$_${dir}$ - #:endfor - #:endfor + integer :: hyper_model !< hyperelasticity solver algorithm + logical :: elasticity !< elasticity modeling, true for hyper or hypo + logical, parameter :: chemistry = .${chemistry}$. !< Chemistry modeling + logical :: shear_stress !< Shear stresses + logical :: bulk_stress !< Bulk stresses + logical :: cont_damage !< Continuum damage modeling + logical :: hyper_cleaning !< Hyperbolic cleaning for MHD for divB=0 + integer :: num_igr_iters !< number of iterations for elliptic solve + integer :: num_igr_warm_start_iters !< number of warm start iterations for elliptic solve + real(wp) :: alf_factor !< alpha factor for IGR + logical :: bodyForces + type(body_force_axis) :: bf_x, bf_y, bf_z !< body force parameters per direction real(wp), dimension(3) :: accel_bf $:GPU_DECLARE(create='[accel_bf]') - ! $:GPU_DECLARE(create='[k_x,w_x,p_x,g_x,k_y,w_y,p_y,g_y,k_z,w_z,p_z,g_z]') integer :: cpu_start, cpu_end, cpu_rate @@ -233,12 +220,11 @@ module m_global_parameters #endif type(bounds_info) :: x_domain, y_domain, z_domain $:GPU_DECLARE(create='[x_domain, y_domain, z_domain]') - real(wp) :: x_a, y_a, z_a - real(wp) :: x_b, y_b, z_b - logical :: parallel_io !< Format of the data files - logical :: file_per_process !< shared file or not when using parallel io - integer :: precision !< Precision of output files - logical :: down_sample !< down sample the output files + type(bounds_info) :: x_stretch, y_stretch, z_stretch + logical :: parallel_io !< Format of the data files + logical :: file_per_process !< shared file or not when using parallel io + integer :: precision !< Precision of output files + logical :: down_sample !< down sample the output files $:GPU_DECLARE(create='[down_sample]') integer, allocatable, dimension(:) :: proc_coords !< Processor coordinates in MPI_CART_COMM @@ -686,13 +672,10 @@ contains surface_tension = .false. bodyForces = .false. - bf_x = .false.; bf_y = .false.; bf_z = .false. - !> amplitude, frequency, and phase shift sinusoid in each direction - #:for dir in {'x', 'y', 'z'} - #:for param in {'k','w','p','g'} - ${param}$_${dir}$ = dflt_real - #:endfor - #:endfor + bf_x%enabled = .false.; bf_y%enabled = .false.; bf_z%enabled = .false. + bf_x%k = 0._wp; bf_x%w = 0._wp; bf_x%p = 0._wp; bf_x%g = 0._wp + bf_y%k = 0._wp; bf_y%w = 0._wp; bf_y%p = 0._wp; bf_y%g = 0._wp + bf_z%k = 0._wp; bf_z%w = 0._wp; bf_z%p = 0._wp; bf_z%g = 0._wp fft_wrt = .false. dummy = .false. @@ -1239,28 +1222,28 @@ contains $:GPU_UPDATE(device='[relax, relax_model, palpha_eps, ptgalpha_eps]') ! Allocating grid variables for the x-, y- and z-directions - @:ALLOCATE(x_cb(-1 - buff_size:m + buff_size)) - @:ALLOCATE(x_cc(-buff_size:m + buff_size)) - @:ALLOCATE(dx(-buff_size:m + buff_size)) - @:PREFER_GPU(x_cb) - @:PREFER_GPU(x_cc) - @:PREFER_GPU(dx) + @:ALLOCATE(x%cb(-1 - buff_size:m + buff_size)) + @:ALLOCATE(x%cc(-buff_size:m + buff_size)) + @:ALLOCATE(x%spacing(-buff_size:m + buff_size)) + @:PREFER_GPU(x%cb) + @:PREFER_GPU(x%cc) + @:PREFER_GPU(x%spacing) if (n == 0) return - @:ALLOCATE(y_cb(-1 - buff_size:n + buff_size)) - @:ALLOCATE(y_cc(-buff_size:n + buff_size)) - @:ALLOCATE(dy(-buff_size:n + buff_size)) - @:PREFER_GPU(y_cb) - @:PREFER_GPU(y_cc) - @:PREFER_GPU(dy) + @:ALLOCATE(y%cb(-1 - buff_size:n + buff_size)) + @:ALLOCATE(y%cc(-buff_size:n + buff_size)) + @:ALLOCATE(y%spacing(-buff_size:n + buff_size)) + @:PREFER_GPU(y%cb) + @:PREFER_GPU(y%cc) + @:PREFER_GPU(y%spacing) if (p == 0) return - @:ALLOCATE(z_cb(-1 - buff_size:p + buff_size)) - @:ALLOCATE(z_cc(-buff_size:p + buff_size)) - @:ALLOCATE(dz(-buff_size:p + buff_size)) - @:PREFER_GPU(z_cb) - @:PREFER_GPU(z_cc) - @:PREFER_GPU(dz) + @:ALLOCATE(z%cb(-1 - buff_size:p + buff_size)) + @:ALLOCATE(z%cc(-buff_size:p + buff_size)) + @:ALLOCATE(z%spacing(-buff_size:p + buff_size)) + @:PREFER_GPU(z%cb) + @:PREFER_GPU(z%cc) + @:PREFER_GPU(z%spacing) end subroutine s_initialize_global_parameters_module @@ -1341,13 +1324,13 @@ contains if (ib) MPI_IO_IB_DATA%var%sf => null() ! Deallocating grid variables for the x-, y- and z-directions - @:DEALLOCATE(x_cb, x_cc, dx) + @:DEALLOCATE(x%cb, x%cc, x%spacing) if (n == 0) return - @:DEALLOCATE(y_cb, y_cc, dy) + @:DEALLOCATE(y%cb, y%cc, y%spacing) if (p == 0) return - @:DEALLOCATE(z_cb, z_cc, dz) + @:DEALLOCATE(z%cb, z%cc, z%spacing) end subroutine s_finalize_global_parameters_module diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 90e78d04df..5fa888981e 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -58,14 +58,14 @@ contains end if ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_hyper, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(m, x%cc, fd_coeff_x_hyper, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_x_hyper]') if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_hyper, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(n, y%cc, fd_coeff_y_hyper, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_y_hyper]') end if if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_hyper, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(p, z%cc, fd_coeff_z_hyper, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_z_hyper]') end if diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 471c155f03..546cbe572f 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -65,14 +65,14 @@ contains end if ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_hypo, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(m, x%cc, fd_coeff_x_hypo, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_x_hypo]') if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_hypo, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(n, y%cc, fd_coeff_y_hypo, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_y_hypo]') end if if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_hypo, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(p, z%cc, fd_coeff_z_hypo, buff_size, fd_number, fd_order) $:GPU_UPDATE(device='[fd_coeff_z_hypo]') end if @@ -301,26 +301,26 @@ contains do k = 0, m ! S_xx -= rho * v/r * (tau_xx + 2/3*G) rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) - rho_K_field(k, l, & - & q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, & + & q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y%cc(l)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, & & q) + (2._wp/3._wp)*G_K_field(k, l, q)) ! tau_xx + 2/3*G ! S_xr -= rho * v/r * tau_xr rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) - rho_K_field(k, & - & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, & + & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y%cc(l)*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, & & l, q) ! tau_xx ! S_rr -= rho * v/r * (tau_rr + 2/3*G) rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) - rho_K_field(k, & & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, & - & q)/y_cc(l)*(q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, & - & q)) ! tau_rr + 2/3*G + & q)/y%cc(l)*(q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, q)) ! tau_rr + 2/3*G - ! S_thetatheta += rho * ( -(tau_thetatheta + 2/3*G)*(du/dx + dv/dr + v/r) + 2*(tau_thetatheta + G)*v/r ) + ! S_thetatheta += rho * ( -(tau_thetatheta + 2/3*G)*(du/x%spacing + dv/dr + v/r) + 2*(tau_thetatheta + + ! G)*v/r ) rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + rho_K_field(k, & & l, q)*(-(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, & & q))*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, & - & q)/y_cc(l)) + 2._wp*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + G_K_field(k, l, & - & q))*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)) + & q)/y%cc(l)) + 2._wp*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + G_K_field(k, l, & + & q))*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y%cc(l)) end do end do end do diff --git a/src/simulation/m_ib_patches.fpp b/src/simulation/m_ib_patches.fpp index 0d3145ddf5..b988340d83 100644 --- a/src/simulation/m_ib_patches.fpp +++ b/src/simulation/m_ib_patches.fpp @@ -111,15 +111,15 @@ contains jl = -gp_layers - 1 ir = m + gp_layers + 1 jr = n + gp_layers + 1 - call get_bounding_indices(center(1) - radius, center(1) + radius, x_cc, il, ir) - call get_bounding_indices(center(2) - radius, center(2) + radius, y_cc, jl, jr) + call get_bounding_indices(center(1) - radius, center(1) + radius, x%cc, il, ir) + call get_bounding_indices(center(2) - radius, center(2) + radius, y%cc, jl, jr) ! Assign primitive variables if circle covers cell and patch has write permission $:GPU_PARALLEL_LOOP(private='[i, j]', copyin='[encoded_patch_id, center, radius]', collapse=2) do j = jl, jr do i = il, ir - if ((x_cc(i) - center(1))**2 + (y_cc(j) - center(2))**2 <= radius**2) then + if ((x%cc(i) - center(1))**2 + (y%cc(j) - center(2))**2 <= radius**2) then ib_markers%sf(i, j, 0) = encoded_patch_id end if end do @@ -152,8 +152,8 @@ contains inverse_rotation(:,:) = patch_ib(patch_id)%rotation_matrix_inverse(:,:) offset(:) = patch_ib(patch_id)%centroid_offset(:) - Np1 = int((pa*ca_in/dx(0))*20) - Np2 = int(((ca_in - pa*ca_in)/dx(0))*20) + Np1 = int((pa*ca_in/x%spacing(0))*20) + Np2 = int(((ca_in - pa*ca_in)/x%spacing(0))*20) Np = Np1 + Np2 + 1 $:GPU_UPDATE(device='[Np]') @@ -224,14 +224,14 @@ contains ir = m + gp_layers + 1 jr = n + gp_layers + 1 ! maximum distance any marker can be from the center is the length of the airfoil - call get_bounding_indices(center(1) - ca_in, center(1) + ca_in, x_cc, il, ir) - call get_bounding_indices(center(2) - ca_in, center(2) + ca_in, y_cc, jl, jr) + call get_bounding_indices(center(1) - ca_in, center(1) + ca_in, x%cc, il, ir) + call get_bounding_indices(center(2) - ca_in, center(2) + ca_in, y%cc, jl, jr) $:GPU_PARALLEL_LOOP(private='[i, j, xy_local, k, f]', copyin='[encoded_patch_id, center, inverse_rotation, offset, ma, & & ca_in, airfoil_grid_u, airfoil_grid_l]', collapse=2) do j = jl, jr do i = il, ir - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] ! get coordinate frame centered on IB + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] ! get coordinate frame centered on IB xy_local = matmul(inverse_rotation, xy_local) ! rotate the frame into the IB's coordinates xy_local = xy_local - offset ! airfoils are a patch that require a centroid offset @@ -310,8 +310,8 @@ contains z_max = lz/2 z_min = -lz/2 - Np1 = int((pa*ca_in/dx(0))*20) - Np2 = int(((ca_in - pa*ca_in)/dx(0))*20) + Np1 = int((pa*ca_in/x%spacing(0))*20) + Np2 = int(((ca_in - pa*ca_in)/x%spacing(0))*20) Np = Np1 + Np2 + 1 $:GPU_UPDATE(device='[Np]') @@ -381,17 +381,17 @@ contains jr = n + gp_layers + 1 lr = p + gp_layers + 1 ! maximum distance any marker can be from the center is the length of the airfoil - call get_bounding_indices(center(1) - ca_in, center(1) + ca_in, x_cc, il, ir) - call get_bounding_indices(center(2) - ca_in, center(2) + ca_in, y_cc, jl, jr) - call get_bounding_indices(center(3) - ca_in, center(3) + ca_in, z_cc, ll, lr) + call get_bounding_indices(center(1) - ca_in, center(1) + ca_in, x%cc, il, ir) + call get_bounding_indices(center(2) - ca_in, center(2) + ca_in, y%cc, jl, jr) + call get_bounding_indices(center(3) - ca_in, center(3) + ca_in, z%cc, ll, lr) $:GPU_PARALLEL_LOOP(private='[i, j, l, xyz_local, k, f]', copyin='[encoded_patch_id, center, inverse_rotation, offset, & & ma, ca_in, airfoil_grid_u, airfoil_grid_l, z_min, z_max]', collapse=3) do l = ll, lr do j = jl, jr do i = il, ir - xyz_local = [x_cc(i) - center(1), y_cc(j) - center(2), & - & z_cc(l) - center(3)] ! get coordinate frame centered on IB + ! get coordinate frame centered on IB + xyz_local = [x%cc(i) - center(1), y%cc(j) - center(2), z%cc(l) - center(3)] xyz_local = matmul(inverse_rotation, xyz_local) ! rotate the frame into the IB's coordinates xyz_local = xyz_local - offset ! airfoils are a patch that require a centroid offset @@ -469,16 +469,16 @@ contains ir = m + gp_layers + 1 jr = n + gp_layers + 1 corner_distance = sqrt(dot_product(length, length))/2._wp ! maximum distance any marker can be from the center - call get_bounding_indices(center(1) - corner_distance, center(1) + corner_distance, x_cc, il, ir) - call get_bounding_indices(center(2) - corner_distance, center(2) + corner_distance, y_cc, jl, jr) + call get_bounding_indices(center(1) - corner_distance, center(1) + corner_distance, x%cc, il, ir) + call get_bounding_indices(center(2) - corner_distance, center(2) + corner_distance, y%cc, jl, jr) ! Assign primitive variables if rectangle covers cell and patch has write permission - $:GPU_PARALLEL_LOOP(private='[i, j, xy_local]', copyin='[encoded_patch_id, center, length, inverse_rotation, x_cc, & - & y_cc]', collapse=2) + $:GPU_PARALLEL_LOOP(private='[i, j, xy_local]', copyin='[encoded_patch_id, center, length, inverse_rotation, x%cc, & + & y%cc]', collapse=2) do j = jl, jr do i = il, ir ! get the x and y coordinates in the local IB frame - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] xy_local = matmul(inverse_rotation, xy_local) if (-0.5_wp*length(1) <= xy_local(1) .and. 0.5_wp*length(1) >= xy_local(1) .and. -0.5_wp*length(2) <= xy_local(2) & @@ -515,9 +515,9 @@ contains radius = patch_ib(patch_id)%radius ! completely skip particles no in the domain - if (center(1) - radius > x_cc(m + gp_layers + 1) .or. center(1) + radius < x_cc(-gp_layers - 1) .or. center(2) & - & - radius > y_cc(n + gp_layers + 1) .or. center(2) + radius < y_cc(-gp_layers - 1) .or. center(3) - radius > z_cc(p & - & + gp_layers + 1) .or. center(3) + radius < z_cc(-gp_layers - 1)) then + if (center(1) - radius > x%cc(m + gp_layers + 1) .or. center(1) + radius < x%cc(-gp_layers - 1) .or. center(2) & + & - radius > y%cc(n + gp_layers + 1) .or. center(2) + radius < y%cc(-gp_layers - 1) .or. center(3) - radius > z%cc(p & + & + gp_layers + 1) .or. center(3) + radius < z%cc(-gp_layers - 1)) then return end if @@ -531,9 +531,9 @@ contains ir = m + gp_layers + 1 jr = n + gp_layers + 1 kr = p + gp_layers + 1 - call get_bounding_indices(center(1) - radius, center(1) + radius, x_cc, il, ir) - call get_bounding_indices(center(2) - radius, center(2) + radius, y_cc, jl, jr) - call get_bounding_indices(center(3) - radius, center(3) + radius, z_cc, kl, kr) + call get_bounding_indices(center(1) - radius, center(1) + radius, x%cc, il, ir) + call get_bounding_indices(center(2) - radius, center(2) + radius, y%cc, jl, jr) + call get_bounding_indices(center(3) - radius, center(3) + radius, z%cc, kl, kr) ! Checking whether the sphere covers a particular cell in the domain and verifying whether the current patch has permission ! to write to that cell. If both queries check out, the primitive variables of the current patch are assigned to this cell. @@ -542,7 +542,7 @@ contains do j = jl, jr do i = il, ir ! Updating the patch identities bookkeeping variable - if (((x_cc(i) - center(1))**2 + (y_cc(j) - center(2))**2 + (z_cc(k) - center(3))**2 <= radius**2)) then + if (((x%cc(i) - center(1))**2 + (y%cc(j) - center(2))**2 + (z%cc(k) - center(3))**2 <= radius**2)) then ib_markers%sf(i, j, k) = encoded_patch_id end if end do @@ -585,9 +585,9 @@ contains jr = n + gp_layers + 1 kr = p + gp_layers + 1 corner_distance = sqrt(dot_product(length, length))/2._wp ! maximum distance any marker can be from the center - call get_bounding_indices(center(1) - corner_distance, center(1) + corner_distance, x_cc, il, ir) - call get_bounding_indices(center(2) - corner_distance, center(2) + corner_distance, y_cc, jl, jr) - call get_bounding_indices(center(3) - corner_distance, center(3) + corner_distance, z_cc, kl, kr) + call get_bounding_indices(center(1) - corner_distance, center(1) + corner_distance, x%cc, il, ir) + call get_bounding_indices(center(2) - corner_distance, center(2) + corner_distance, y%cc, jl, jr) + call get_bounding_indices(center(3) - corner_distance, center(3) + corner_distance, z%cc, kl, kr) ! Checking whether the cuboid covers a particular cell in the domain and verifying whether the current patch has permission ! to write to to that cell. If both queries check out, the primitive variables of the current patch are assigned to this @@ -597,7 +597,7 @@ contains do k = kl, kr do j = jl, jr do i = il, ir - xyz_local = [x_cc(i), y_cc(j), z_cc(k)] - center ! get coordinate frame centered on IB + xyz_local = [x%cc(i), y%cc(j), z%cc(k)] - center ! get coordinate frame centered on IB xyz_local = matmul(inverse_rotation, xyz_local) ! rotate the frame into the IB's coordinates if (-0.5*length(1) <= xyz_local(1) .and. 0.5*length(1) >= xyz_local(1) .and. -0.5*length(2) <= xyz_local(2) & @@ -647,9 +647,9 @@ contains jr = n + gp_layers + 1 kr = p + gp_layers + 1 corner_distance = sqrt(radius**2 + maxval(length)**2) ! distance to rim of cylinder - call get_bounding_indices(center(1) - corner_distance, center(1) + corner_distance, x_cc, il, ir) - call get_bounding_indices(center(2) - corner_distance, center(2) + corner_distance, y_cc, jl, jr) - call get_bounding_indices(center(3) - corner_distance, center(3) + corner_distance, z_cc, kl, kr) + call get_bounding_indices(center(1) - corner_distance, center(1) + corner_distance, x%cc, il, ir) + call get_bounding_indices(center(2) - corner_distance, center(2) + corner_distance, y%cc, jl, jr) + call get_bounding_indices(center(3) - corner_distance, center(3) + corner_distance, z%cc, kl, kr) ! Checking whether the cylinder covers a particular cell in the domain and verifying whether the current patch has the ! permission to write to that cell. If both queries check out, the primitive variables of the current patch are assigned to @@ -659,7 +659,7 @@ contains do k = kl, kr do j = jl, jr do i = il, ir - xyz_local = [x_cc(i), y_cc(j), z_cc(k)] - center ! get coordinate frame centered on IB + xyz_local = [x%cc(i), y%cc(j), z%cc(k)] - center ! get coordinate frame centered on IB xyz_local = matmul(inverse_rotation, xyz_local) ! rotate the frame into the IB's coordinates if (((.not. f_is_default(length(1)) .and. xyz_local(2)**2 + xyz_local(3)**2 <= radius**2 .and. & @@ -707,16 +707,16 @@ contains jl = -gp_layers - 1 ir = m + gp_layers + 1 jr = n + gp_layers + 1 - call get_bounding_indices(center(1) - maxval(ellipse_coeffs)*2._wp, center(1) + maxval(ellipse_coeffs)*2._wp, x_cc, il, ir) - call get_bounding_indices(center(2) - maxval(ellipse_coeffs)*2._wp, center(2) + maxval(ellipse_coeffs)*2._wp, y_cc, jl, jr) + call get_bounding_indices(center(1) - maxval(ellipse_coeffs)*2._wp, center(1) + maxval(ellipse_coeffs)*2._wp, x%cc, il, ir) + call get_bounding_indices(center(2) - maxval(ellipse_coeffs)*2._wp, center(2) + maxval(ellipse_coeffs)*2._wp, y%cc, jl, jr) ! Checking whether the ellipse covers a particular cell in the domain $:GPU_PARALLEL_LOOP(private='[i, j, xy_local]', copyin='[encoded_patch_id, center, ellipse_coeffs, inverse_rotation, & - & x_cc, y_cc]', collapse=2) + & x%cc, y%cc]', collapse=2) do j = jl, jr do i = il, ir ! get the x and y coordinates in the local IB frame - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] xy_local = matmul(inverse_rotation, xy_local) ! Ellipse condition (x/a)^2 + (y/b)^2 <= 1 @@ -784,14 +784,14 @@ contains end do end do - call get_bounding_indices(bbox_min(1), bbox_max(1), x_cc, il, ir) - call get_bounding_indices(bbox_min(2), bbox_max(2), y_cc, jl, jr) + call get_bounding_indices(bbox_min(1), bbox_max(1), x%cc, il, ir) + call get_bounding_indices(bbox_min(2), bbox_max(2), y%cc, jl, jr) $:GPU_PARALLEL_LOOP(private='[i, j, xy_local, eta]', copyin='[patch_id, encoded_patch_id, center, inverse_rotation, & & offset, spc, threshold]', collapse=2) do i = il, ir do j = jl, jr - xy_local = [x_cc(i) - center(1), y_cc(j) - center(2), 0._wp] + xy_local = [x%cc(i) - center(1), y%cc(j) - center(2), 0._wp] xy_local = matmul(inverse_rotation, xy_local) xy_local = xy_local - offset @@ -869,16 +869,16 @@ contains end do end do - call get_bounding_indices(bbox_min(1), bbox_max(1), x_cc, il, ir) - call get_bounding_indices(bbox_min(2), bbox_max(2), y_cc, jl, jr) - call get_bounding_indices(bbox_min(3), bbox_max(3), z_cc, kl, kr) + call get_bounding_indices(bbox_min(1), bbox_max(1), x%cc, il, ir) + call get_bounding_indices(bbox_min(2), bbox_max(2), y%cc, jl, jr) + call get_bounding_indices(bbox_min(3), bbox_max(3), z%cc, kl, kr) $:GPU_PARALLEL_LOOP(private='[i, j, k, xyz_local, eta]', copyin='[patch_id, encoded_patch_id, center, inverse_rotation, & & offset, spc, threshold]', collapse=3) do i = il, ir do j = jl, jr do k = kl, kr - xyz_local = [x_cc(i) - center(1), y_cc(j) - center(2), z_cc(k) - center(3)] + xyz_local = [x%cc(i) - center(1), y%cc(j) - center(2), z%cc(k) - center(3)] xyz_local = matmul(inverse_rotation, xyz_local) xyz_local = xyz_local - offset diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 5f865cffeb..71d0bcc530 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -82,9 +82,9 @@ contains $:GPU_UPDATE(device='[patch_ib(1:num_ibs)]') ! GPU routines require updated cell centers - $:GPU_UPDATE(device='[num_ibs, x_cc, y_cc, dx, dy, x_domain, y_domain, ib_bc_x%beg, ib_bc_y%beg]') + $:GPU_UPDATE(device='[num_ibs, x%cc, y%cc, x%spacing, y%spacing, x_domain, y_domain, ib_bc_x%beg, ib_bc_y%beg]') if (p /= 0) then - $:GPU_UPDATE(device='[z_cc, dz, z_domain, ib_bc_z%beg]') + $:GPU_UPDATE(device='[z%cc, z%spacing, z_domain, ib_bc_z%beg]') end if ! allocate STL models @@ -204,9 +204,9 @@ contains ! Calculate physical location of GP if (p > 0) then - physical_loc = [x_cc(j), y_cc(k), z_cc(l)] + physical_loc = [x%cc(j), y%cc(k), z%cc(l)] else - physical_loc = [x_cc(j), y_cc(k), 0._wp] + physical_loc = [x%cc(j), y%cc(k), 0._wp] end if ! Interpolate primitive variables at image point associated w/ GP @@ -404,9 +404,9 @@ contains ! Calculate physical location of ghost point if (p > 0) then - physical_loc = [x_cc(i), y_cc(j), z_cc(k)] + physical_loc = [x%cc(i), y%cc(j), z%cc(k)] else - physical_loc = [x_cc(i), y_cc(j), 0._wp] + physical_loc = [x%cc(i), y%cc(j), 0._wp] end if ! Calculate and store the precise location of the image point @@ -419,13 +419,13 @@ contains do dim = 1, num_dims ! s_cc points to the dim array we need if (dim == 1) then - s_cc => x_cc + s_cc => x%cc bound = m + buff_size - 1 else if (dim == 2) then - s_cc => y_cc + s_cc => y%cc bound = n + buff_size - 1 else - s_cc => z_cc + s_cc => z%cc bound = p + buff_size - 1 end if @@ -448,15 +448,15 @@ contains print *, "A required image point is not located in this computational domain." print *, "Ghost Point is located at :" if (p == 0) then - print *, [x_cc(i), y_cc(j)] + print *, [x%cc(i), y%cc(j)] else - print *, [x_cc(i), y_cc(j), z_cc(k)] + print *, [x%cc(i), y%cc(j), z%cc(k)] end if print *, "We are searching in dimension ", dim, " for image point at ", ghost_points_in(q)%ip_loc(:) - print *, "Domain size: ", [x_cc(-buff_size), y_cc(-buff_size), z_cc(-buff_size)] - print *, "x: ", x_cc(-buff_size), " to: ", x_cc(m + buff_size - 1) - print *, "y: ", y_cc(-buff_size), " to: ", y_cc(n + buff_size - 1) - if (p /= 0) print *, "z: ", z_cc(-buff_size), " to: ", z_cc(p + buff_size - 1) + print *, "Domain size: ", [x%cc(-buff_size), y%cc(-buff_size), z%cc(-buff_size)] + print *, "x: ", x%cc(-buff_size), " to: ", x%cc(m + buff_size - 1) + print *, "y: ", y%cc(-buff_size), " to: ", y%cc(n + buff_size - 1) + if (p /= 0) print *, "z: ", z%cc(-buff_size), " to: ", z%cc(p + buff_size - 1) print *, "Image point is located approximately ", & & (ghost_points_in(q)%loc(dim) - ghost_points_in(q) %ip_loc(dim))/(s_cc(1) - s_cc(0)), & & " grid cells away" @@ -544,8 +544,7 @@ contains if (p == 0) gp_layers_z = 0 $:GPU_PARALLEL_LOOP(private='[i, j, k, ii, jj, kk, is_gp, local_idx, patch_id, encoded_patch_id, xp, yp, zp]', & - & copyin='[count, count_i, x_domain, y_domain, z_domain]', firstprivate='[gp_layers, gp_layers_z]', & - & collapse=3) + & copyin='[count, count_i, x_domain, y_domain, z_domain]', firstprivate='[gp_layers, gp_layers_z]', collapse=3) do i = 0, m do j = 0, n do k = 0, p @@ -578,26 +577,26 @@ contains ghost_points_in(local_idx)%z_periodicity = zp ghost_points_in(local_idx)%slip = patch_ib(patch_id)%slip - if ((x_cc(i) - dx(i)) < x_domain%beg) then + if ((x%cc(i) - x%spacing(i)) < x_domain%beg) then ghost_points_in(local_idx)%DB(1) = -1 - else if ((x_cc(i) + dx(i)) > x_domain%end) then + else if ((x%cc(i) + x%spacing(i)) > x_domain%end) then ghost_points_in(local_idx)%DB(1) = 1 else ghost_points_in(local_idx)%DB(1) = 0 end if - if ((y_cc(j) - dy(j)) < y_domain%beg) then + if ((y%cc(j) - y%spacing(j)) < y_domain%beg) then ghost_points_in(local_idx)%DB(2) = -1 - else if ((y_cc(j) + dy(j)) > y_domain%end) then + else if ((y%cc(j) + y%spacing(j)) > y_domain%end) then ghost_points_in(local_idx)%DB(2) = 1 else ghost_points_in(local_idx)%DB(2) = 0 end if if (p /= 0) then - if ((z_cc(k) - dz(k)) < z_domain%beg) then + if ((z%cc(k) - z%spacing(k)) < z_domain%beg) then ghost_points_in(local_idx)%DB(3) = -1 - else if ((z_cc(k) + dz(k)) > z_domain%end) then + else if ((z%cc(k) + z%spacing(k)) > z_domain%end) then ghost_points_in(local_idx)%DB(3) = 1 else ghost_points_in(local_idx)%DB(3) = 0 @@ -644,11 +643,11 @@ contains do ii = 0, 1 do jj = 0, 1 if (p == 0) then - dist(1 + ii, 1 + jj, 1) = sqrt((x_cc(i + ii) - gp%ip_loc(1))**2 + (y_cc(j + jj) - gp%ip_loc(2))**2) + dist(1 + ii, 1 + jj, 1) = sqrt((x%cc(i + ii) - gp%ip_loc(1))**2 + (y%cc(j + jj) - gp%ip_loc(2))**2) else do kk = 0, 1 dist(1 + ii, 1 + jj, & - & 1 + kk) = sqrt((x_cc(i + ii) - gp%ip_loc(1))**2 + (y_cc(j + jj) - gp%ip_loc(2))**2 + (z_cc(k & + & 1 + kk) = sqrt((x%cc(i + ii) - gp%ip_loc(1))**2 + (y%cc(j + jj) - gp%ip_loc(2))**2 + (z%cc(k & & + kk) - gp%ip_loc(3))**2) end do end if @@ -888,10 +887,10 @@ contains type(physical_parameters), dimension(1:num_fluids), intent(in) :: fluid_pp integer :: i, j, k, l, encoded_ib_idx, ib_idx, fluid_idx real(wp), dimension(num_ibs, 3) :: forces, torques - real(wp), dimension(1:3,1:3) :: viscous_stress_div, viscous_stress_div_1, & - & viscous_stress_div_2 ! viscous stress tensor with temp vectors to hold divergence calculations - real(wp), dimension(1:3) :: local_force_contribution, radial_vector, local_torque_contribution - real(wp) :: cell_volume, dx, dy, dz, dynamic_viscosity + ! viscous stress tensor with temp vectors to hold divergence calculations + real(wp), dimension(1:3,1:3) :: viscous_stress_div, viscous_stress_div_1, viscous_stress_div_2 + real(wp), dimension(1:3) :: local_force_contribution, radial_vector, local_torque_contribution + real(wp) :: cell_volume, dx_loc, dy_loc, dz_loc, dynamic_viscosity #:if not MFC_CASE_OPTIMIZATION and USING_AMD real(wp), dimension(3) :: dynamic_viscosities @@ -916,7 +915,7 @@ contains $:GPU_PARALLEL_LOOP(private='[ib_idx, encoded_ib_idx, fluid_idx, radial_vector, local_force_contribution, cell_volume, & & local_torque_contribution, dynamic_viscosity, viscous_stress_div, viscous_stress_div_1, & - & viscous_stress_div_2, dx, dy, dz]', copy='[forces, torques]', copyin='[patch_ib, & + & viscous_stress_div_2, dx_loc, dy_loc, dz_loc]', copy='[forces, torques]', copyin='[patch_ib, & & dynamic_viscosities]', collapse=3) do i = 0, m do j = 0, n @@ -927,32 +926,31 @@ contains ! get the vector pointing to the grid cell from the IB centroid if (num_dims == 3) then - radial_vector = [x_cc(i), y_cc(j), z_cc(k)] - [patch_ib(ib_idx)%x_centroid, & + radial_vector = [x%cc(i), y%cc(j), z%cc(k)] - [patch_ib(ib_idx)%x_centroid, & & patch_ib(ib_idx)%y_centroid, patch_ib(ib_idx)%z_centroid] else - radial_vector = [x_cc(i), y_cc(j), 0._wp] - [patch_ib(ib_idx)%x_centroid, & + radial_vector = [x%cc(i), y%cc(j), 0._wp] - [patch_ib(ib_idx)%x_centroid, & & patch_ib(ib_idx)%y_centroid, 0._wp] end if - dx = x_cc(i + 1) - x_cc(i) - dy = y_cc(j + 1) - y_cc(j) + dx_loc = x%cc(i + 1) - x%cc(i) + dy_loc = y%cc(j + 1) - y%cc(j) local_force_contribution(:) = 0._wp do fluid_idx = 0, num_fluids - 1 ! Get the pressure contribution to force via a finite difference to compute the 2D components of the ! gradient of the pressure and cell volume local_force_contribution(1) = local_force_contribution(1) - (q_prim_vf(eqn_idx%E + fluid_idx)%sf(i & - & + 1, j, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i - 1, j, & - & k))/(2._wp*dx) ! force is the negative pressure gradient + & + 1, j, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i - 1, j, k))/(2._wp*dx_loc) ! force is the negative pressure gradient local_force_contribution(2) = local_force_contribution(2) - (q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, & - & j + 1, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, j - 1, k))/(2._wp*dy) - cell_volume = abs(dx*dy) + & j + 1, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, j - 1, k))/(2._wp*dy_loc) + cell_volume = abs(dx_loc*dy_loc) ! add the 3D component of the pressure gradient, if we are working in 3 dimensions if (num_dims == 3) then - dz = z_cc(k + 1) - z_cc(k) - local_force_contribution(3) = local_force_contribution(3) - (q_prim_vf(eqn_idx%E + fluid_idx) & - & %sf(i, j, k + 1) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, j, & - & k - 1))/(2._wp*dz) - cell_volume = abs(cell_volume*dz) + dz_loc = z%cc(k + 1) - z%cc(k) + local_force_contribution(3) = local_force_contribution(3) - (q_prim_vf(eqn_idx%E & + & + fluid_idx)%sf(i, j, k + 1) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, & + & j, k - 1))/(2._wp*dz_loc) + cell_volume = abs(cell_volume*dz_loc) end if end do @@ -969,27 +967,28 @@ contains ! get the linear force components first call s_compute_viscous_stress_tensor(viscous_stress_div_1, q_prim_vf, dynamic_viscosity, i - 1, j, k) call s_compute_viscous_stress_tensor(viscous_stress_div_2, q_prim_vf, dynamic_viscosity, i + 1, j, k) - viscous_stress_div(1,1:3) = (viscous_stress_div_2(1,1:3) - viscous_stress_div_1(1, & - & 1:3))/(2._wp*dx) ! get x derivative of the first-row of viscous stress tensor - local_force_contribution(1:3) = local_force_contribution(1:3) + viscous_stress_div(1, & - & 1:3) ! add the x components of the divergence to the force + ! get x derivative of the first-row of viscous stress tensor + viscous_stress_div(1,1:3) = (viscous_stress_div_2(1,1:3) - viscous_stress_div_1(1,1:3))/(2._wp*dx_loc) + ! add the x components of the divergence to the force + local_force_contribution(1:3) = local_force_contribution(1:3) + viscous_stress_div(1,1:3) call s_compute_viscous_stress_tensor(viscous_stress_div_1, q_prim_vf, dynamic_viscosity, i, j - 1, k) call s_compute_viscous_stress_tensor(viscous_stress_div_2, q_prim_vf, dynamic_viscosity, i, j + 1, k) - viscous_stress_div(2,1:3) = (viscous_stress_div_2(2,1:3) - viscous_stress_div_1(2, & - & 1:3))/(2._wp*dy) ! get y derivative of the second-row of viscous stress tensor - local_force_contribution(1:3) = local_force_contribution(1:3) + viscous_stress_div(2, & - & 1:3) ! add the y components of the divergence to the force + ! get y derivative of the second-row of viscous stress tensor + viscous_stress_div(2,1:3) = (viscous_stress_div_2(2,1:3) - viscous_stress_div_1(2,1:3))/(2._wp*dy_loc) + ! add the y components of the divergence to the force + local_force_contribution(1:3) = local_force_contribution(1:3) + viscous_stress_div(2,1:3) if (num_dims == 3) then call s_compute_viscous_stress_tensor(viscous_stress_div_1, q_prim_vf, dynamic_viscosity, i, j, & & k - 1) call s_compute_viscous_stress_tensor(viscous_stress_div_2, q_prim_vf, dynamic_viscosity, i, j, & & k + 1) + ! get z derivative of the third-row of viscous stress tensor viscous_stress_div(3,1:3) = (viscous_stress_div_2(3,1:3) - viscous_stress_div_1(3, & - & 1:3))/(2._wp*dz) ! get z derivative of the third-row of viscous stress tensor - local_force_contribution(1:3) = local_force_contribution(1:3) + viscous_stress_div(3, & - & 1:3) ! add the z components of the divergence to the force + & 1:3))/(2._wp*dz_loc) + ! add the z components of the divergence to the force + local_force_contribution(1:3) = local_force_contribution(1:3) + viscous_stress_div(3,1:3) end if end if @@ -1016,13 +1015,13 @@ contains ! consider body forces after reducing to avoid double counting do i = 1, num_ibs - if (bf_x) then + if (bf_x%enabled) then forces(i, 1) = forces(i, 1) + accel_bf(1)*patch_ib(i)%mass end if - if (bf_y) then + if (bf_y%enabled) then forces(i, 2) = forces(i, 2) + accel_bf(2)*patch_ib(i)%mass end if - if (bf_z) then + if (bf_z%enabled) then forces(i, 3) = forces(i, 3) + accel_bf(3)*patch_ib(i)%mass end if end do @@ -1060,8 +1059,8 @@ contains ! Offset only needs to be computes for specific geometries - if (patch_ib(ib_marker)%geometry == 4 .or. patch_ib(ib_marker)%geometry == 5 .or. patch_ib(ib_marker) & - & %geometry == 11 .or. patch_ib(ib_marker)%geometry == 12) then + if (patch_ib(ib_marker)%geometry == 4 .or. patch_ib(ib_marker)%geometry == 5 .or. patch_ib(ib_marker)%geometry == 11 & + & .or. patch_ib(ib_marker)%geometry == 12) then center_of_mass_local = [0._wp, 0._wp, 0._wp] num_cells_local = 0 @@ -1071,8 +1070,8 @@ contains do k = 0, p if (ib_markers%sf(i, j, k) == ib_marker) then num_cells_local = num_cells_local + 1 - center_of_mass_local = center_of_mass_local + [x_cc(i), y_cc(j), 0._wp] - if (num_dims == 3) center_of_mass_local(3) = center_of_mass_local(3) + z_cc(k) + center_of_mass_local = center_of_mass_local + [x%cc(i), y%cc(j), 0._wp] + if (num_dims == 3) center_of_mass_local(3) = center_of_mass_local(3) + z%cc(k) end if end do end do @@ -1130,20 +1129,20 @@ contains if (patch_ib(ib_marker)%geometry == 2) then ! circle patch_ib(ib_marker)%moment = 0.5_wp*patch_ib(ib_marker)%mass*(patch_ib(ib_marker)%radius)**2 else if (patch_ib(ib_marker)%geometry == 3) then ! rectangle - patch_ib(ib_marker)%moment = patch_ib(ib_marker)%mass*(patch_ib(ib_marker)%length_x**2 + patch_ib(ib_marker) & - & %length_y**2)/6._wp + patch_ib(ib_marker)%moment = patch_ib(ib_marker)%mass*(patch_ib(ib_marker)%length_x**2 & + & + patch_ib(ib_marker)%length_y**2)/6._wp else if (patch_ib(ib_marker)%geometry == 6) then ! ellipse - patch_ib(ib_marker)%moment = 0.0625_wp*patch_ib(ib_marker)%mass*(patch_ib(ib_marker)%length_x**2 + patch_ib(ib_marker) & - & %length_y**2) + patch_ib(ib_marker)%moment = 0.0625_wp*patch_ib(ib_marker)%mass*(patch_ib(ib_marker)%length_x**2 & + & + patch_ib(ib_marker)%length_y**2) else if (patch_ib(ib_marker)%geometry == 8) then ! sphere patch_ib(ib_marker)%moment = 0.4*patch_ib(ib_marker)%mass*(patch_ib(ib_marker)%radius)**2 else ! we do not have an analytic moment of inertia calculation and need to approximate it directly via a sum count = 0 moment = 0._wp - cell_volume = (x_cc(1) - x_cc(0))*(y_cc(1) - y_cc(0)) + cell_volume = (x%cc(1) - x%cc(0))*(y%cc(1) - y%cc(0)) ! computed without grid stretching. Update in the loop to perform with stretching if (p /= 0) then - cell_volume = cell_volume*(z_cc(1) - z_cc(0)) + cell_volume = cell_volume*(z%cc(1) - z%cc(0)) end if $:GPU_PARALLEL_LOOP(private='[position, closest_point_along_axis, vector_to_axis, distance_to_axis]', copy='[moment, & @@ -1157,10 +1156,10 @@ contains ! get the position in local coordinates so that the axis passes through 0, 0, 0 if (p == 0) then - position = [x_cc(i), y_cc(j), 0._wp] - [patch_ib(ib_marker)%x_centroid, & + position = [x%cc(i), y%cc(j), 0._wp] - [patch_ib(ib_marker)%x_centroid, & & patch_ib(ib_marker)%y_centroid, 0._wp] else - position = [x_cc(i), y_cc(j), z_cc(k)] - [patch_ib(ib_marker)%x_centroid, & + position = [x%cc(i), y%cc(j), z%cc(k)] - [patch_ib(ib_marker)%x_centroid, & & patch_ib(ib_marker)%y_centroid, patch_ib(ib_marker)%z_centroid] end if diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp index 9b9cf64133..f0788fcf79 100644 --- a/src/simulation/m_igr.fpp +++ b/src/simulation/m_igr.fpp @@ -158,9 +158,9 @@ contains $:END_GPU_PARALLEL_LOOP() if (p == 0) then - alf_igr = alf_factor*max(dx(1), dy(1))**2._wp + alf_igr = alf_factor*max(x%spacing(1), y%spacing(1))**2._wp else - alf_igr = alf_factor*max(dx(1), dy(1), dz(1))**2._wp + alf_igr = alf_factor*max(x%spacing(1), y%spacing(1), z%spacing(1))**2._wp end if $:GPU_UPDATE(device='[alf_igr]') @@ -261,37 +261,37 @@ contains fd_coeff = fd_coeff + q_cons_vf(i)%sf(j, k, l) end do - fd_coeff = 1._wp/fd_coeff + alf_igr*((1._wp/dx(j)**2._wp)*(1._wp/rho_lx + 1._wp/rho_rx) + (1._wp/dy(k) & - & **2._wp)*(1._wp/rho_ly + 1._wp/rho_ry)) + fd_coeff = 1._wp/fd_coeff + alf_igr*((1._wp/x%spacing(j)**2._wp)*(1._wp/rho_lx + 1._wp/rho_rx) & + & + (1._wp/y%spacing(k)**2._wp)*(1._wp/rho_ly + 1._wp/rho_ry)) if (num_dims == 3) then - fd_coeff = fd_coeff + alf_igr*(1._wp/dz(l)**2._wp)*(1._wp/rho_lz + 1._wp/rho_rz) + fd_coeff = fd_coeff + alf_igr*(1._wp/z%spacing(l)**2._wp)*(1._wp/rho_lz + 1._wp/rho_rz) end if if (igr_iter_solver == 1) then ! Jacobi iteration if (num_dims == 3) then - jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/dx(j)**2._wp)*(jac_old(j - 1, k, & - & l)/rho_lx + jac_old(j + 1, k, l)/rho_rx) + (1._wp/dy(k)**2._wp)*(jac_old(j, k - 1, & - & l)/rho_ly + jac_old(j, k + 1, l)/rho_ry) + (1._wp/dz(l)**2._wp)*(jac_old(j, k, & + jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/x%spacing(j)**2._wp)*(jac_old(j - 1, k, & + & l)/rho_lx + jac_old(j + 1, k, l)/rho_rx) + (1._wp/y%spacing(k)**2._wp)*(jac_old(j, k - 1, & + & l)/rho_ly + jac_old(j, k + 1, l)/rho_ry) + (1._wp/z%spacing(l)**2._wp)*(jac_old(j, k, & & l - 1)/rho_lz + jac_old(j, k, l + 1)/rho_rz)) + real(jac_rhs(j, k, l), kind=wp)/fd_coeff, & & kind=stp) else - jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/dx(j)**2._wp)*(real(jac_old(j - 1, k, l), & + jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/x%spacing(j)**2._wp)*(real(jac_old(j - 1, k, l), & & kind=wp)/rho_lx + real(jac_old(j + 1, k, l), & - & kind=wp)/rho_rx) + (1._wp/dy(k)**2._wp)*(real(jac_old(j, k - 1, l), & + & kind=wp)/rho_rx) + (1._wp/y%spacing(k)**2._wp)*(real(jac_old(j, k - 1, l), & & kind=wp)/rho_ly + real(jac_old(j, k + 1, l), kind=wp)/rho_ry)) + real(jac_rhs(j, k, l), & & kind=wp)/fd_coeff, kind=stp) end if else ! Gauss Seidel iteration if (num_dims == 3) then - jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/dx(j)**2._wp)*(jac(j - 1, k, & - & l)/rho_lx + jac(j + 1, k, l)/rho_rx) + (1._wp/dy(k)**2._wp)*(jac(j, k - 1, & - & l)/rho_ly + jac(j, k + 1, l)/rho_ry) + (1._wp/dz(l)**2._wp)*(jac(j, k, & + jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/x%spacing(j)**2._wp)*(jac(j - 1, k, & + & l)/rho_lx + jac(j + 1, k, l)/rho_rx) + (1._wp/y%spacing(k)**2._wp)*(jac(j, k - 1, & + & l)/rho_ly + jac(j, k + 1, l)/rho_ry) + (1._wp/z%spacing(l)**2._wp)*(jac(j, k, & & l - 1)/rho_lz + jac(j, k, l + 1)/rho_rz)) + real(jac_rhs(j, k, l), kind=wp)/fd_coeff, & & kind=stp) else - jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/dx(j)**2._wp)*(jac(j - 1, k, & - & l)/rho_lx + jac(j + 1, k, l)/rho_rx) + (1._wp/dy(k)**2._wp)*(jac(j, k - 1, & + jac(j, k, l) = real((alf_igr/fd_coeff)*((1._wp/x%spacing(j)**2._wp)*(jac(j - 1, k, & + & l)/rho_lx + jac(j + 1, k, l)/rho_rx) + (1._wp/y%spacing(k)**2._wp)*(jac(j, k - 1, & & l)/rho_ly + jac(j, k + 1, l)/rho_ry)) + real(jac_rhs(j, k, l), kind=wp)/fd_coeff, kind=stp) end if end if @@ -380,16 +380,16 @@ contains #:for LR in ['L', 'R'] $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) + real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j + 1)), kind=stp) + & l) + real(0.5_wp*dt*F_${LR}$*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) + real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j + 1)), kind=stp) + & l) + real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, l) - real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j)), & - & kind=stp) + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & + & l) - real(0.5_wp*dt*F_${LR}$*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) + & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/x%spacing(j)), kind=stp) #:endfor end do end do @@ -456,10 +456,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(1._wp*q_cons_vf(igr_momxb)%sf(j + 1 + q, k, & + dvel_small(1) = (1/(2._wp*x%spacing(j)))*(1._wp*q_cons_vf(igr_momxb)%sf(j + 1 + q, k, & & l)/rho_sf_small(1) - 1._wp*q_cons_vf(igr_momxb)%sf(j - 1 + q, k, & & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1 + q, k, & + dvel_small(2) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1 + q, k, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) if (q == 0) then @@ -489,9 +489,9 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j + q, k + 1, & + dvel_small(1) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb)%sf(j + q, k + 1, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j + q, k - 1, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k + 1, & + dvel_small(2) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k + 1, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j + q, k - 1, l)/rho_sf_small(-1)) if (q == 0) then @@ -615,59 +615,59 @@ contains $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/x%spacing(j)), kind=stp) end if E_L = 0._wp; E_R = 0._wp @@ -688,13 +688,13 @@ contains do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j + 1, k, l) = rhs_vf(i)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/x%spacing(j))), kind=stp) end do if (num_fluids > 1) then @@ -702,67 +702,67 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) - real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l)*vel_L(1)*(1._wp/dx(j + 1))), kind=stp) + & l)*vel_L(1)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_L(1)*(1._wp/dx(j))), kind=stp) + & l)*vel_L(1)*(1._wp/x%spacing(j))), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j + 1)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/x%spacing(j)) - 0.5_wp*dt*cfl*(E_L) & + & *(1._wp/x%spacing(j))), kind=stp) $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j + 1, k, l) = rhs_vf(i)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/x%spacing(j))), kind=stp) end do if (num_fluids > 1) then @@ -770,55 +770,55 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) - real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l)*vel_R(1)*(1._wp/dx(j + 1))), kind=stp) + & l)*vel_R(1)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_R(1)*(1._wp/dx(j))), kind=stp) + & l)*vel_R(1)*(1._wp/x%spacing(j))), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j + 1)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/x%spacing(j)) + 0.5_wp*dt*cfl*(E_R) & + & *(1._wp/x%spacing(j))), kind=stp) end do end do end do @@ -855,11 +855,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1 + q, k, & + dvel_small(1) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb)%sf(j + 1 + q, k, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1 + q, k, & + dvel_small(2) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1 + q, k, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 2)%sf(j + 1 + q, k, & + dvel_small(3) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb + 2)%sf(j + 1 + q, k, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) if (q == 0) then @@ -891,12 +891,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j + q, k + 1, & + dvel_small(1) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb)%sf(j + q, k + 1, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j + q, k - 1, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k + 1, & + dvel_small(2) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k + 1, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j + q, k - 1, l)/rho_sf_small(-1)) - if (q == 0) dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 2)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j + q, k - 1, l)/rho_sf_small(-1)) + if (q == 0) dvel_small(3) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 2)%sf(j + q, & + & k + 1, l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j + q, k - 1, l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims @@ -924,11 +924,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb)%sf(j + q, k, & + dvel_small(1) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb)%sf(j + q, k, & & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j + q, k, l - 1)/rho_sf_small(-1)) - if (q == 0) dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k, & + if (q == 0) dvel_small(2) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k, & & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j + q, k, l - 1)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 2)%sf(j + q, k, & + dvel_small(3) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb + 2)%sf(j + q, k, & & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j + q, k, & & l - 1)/rho_sf_small(-1)) if (q == 0) then @@ -1054,87 +1054,87 @@ contains $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/x%spacing(j)), kind=stp) end if E_L = 0._wp; E_R = 0._wp @@ -1156,13 +1156,13 @@ contains do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j + 1, k, l) = rhs_vf(i)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_rho_L(i)*vel_L(1))*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/x%spacing(j))), kind=stp) end do if (num_fluids > 1) then @@ -1170,77 +1170,77 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l)*vel_L(1)*(1._wp/dx(j + 1)), kind=stp) + & l)*vel_L(1)*(1._wp/x%spacing(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/x%spacing(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_L(1)*(1._wp/dx(j)), kind=stp) + & l)*vel_L(1)*(1._wp/x%spacing(j)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dx(j + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j + 1)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/x%spacing(j + 1)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dx(j)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/x%spacing(j)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/x%spacing(j)) - 0.5_wp*dt*cfl*(E_L) & + & *(1._wp/x%spacing(j))), kind=stp) $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j + 1, k, l) = rhs_vf(i)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_rho_R(i)*vel_R(1))*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/x%spacing(j))), kind=stp) end do if (num_fluids > 1) then @@ -1248,65 +1248,65 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) - real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & - & l)*vel_R(1)*(1._wp/dx(j + 1))), kind=stp) + & l)*vel_R(1)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_R(1)*(1._wp/dx(j))), kind=stp) + & l)*vel_R(1)*(1._wp/x%spacing(j))), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dx(j + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & - & l) + real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j + 1)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dx(j + 1))), kind=stp) + & l) + real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/x%spacing(j + 1)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/x%spacing(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dx(j)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/x%spacing(j)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/x%spacing(j))), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dx(j))), kind=stp) + & l) - real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/x%spacing(j)) + 0.5_wp*dt*cfl*(E_R) & + & *(1._wp/x%spacing(j))), kind=stp) end do end do end do @@ -1346,9 +1346,9 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k + q, & + dvel_small(1) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1, k + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1, k + q, & + dvel_small(2) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1, k + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1, k + q, & & l)/rho_sf_small(-1)) @@ -1372,9 +1372,9 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j, k + 1 + q, & + dvel_small(1) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb)%sf(j, k + 1 + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1 + q, & + dvel_small(2) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1 + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k - 1 + q, & & l)/rho_sf_small(-1)) @@ -1489,59 +1489,59 @@ contains $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/y%spacing(k)), kind=stp) end if E_L = 0._wp; E_R = 0._wp @@ -1566,13 +1566,13 @@ contains do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k + 1, l) = rhs_vf(i)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/dy(k)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/y%spacing(k)), kind=stp) end do if (num_fluids > 1) then @@ -1580,66 +1580,66 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) + & l)*vel_L(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_L(2)*(1._wp/dy(k)), kind=stp) + & l)*vel_L(2)*(1._wp/y%spacing(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(E_L)*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(rho_L*vel_L(1) & - & )*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/y%spacing(k)), kind=stp) $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k + 1, l) = rhs_vf(i)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/dy(k)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/y%spacing(k)), kind=stp) end do if (num_fluids > 1) then @@ -1647,49 +1647,49 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) + & l)*vel_R(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_R(2)*(1._wp/dy(k)), kind=stp) + & l)*vel_R(2)*(1._wp/y%spacing(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(E_R)*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(rho_R*vel_R(1) & - & )*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/y%spacing(k)), kind=stp) end do end do end do @@ -1727,9 +1727,9 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k + q, & + dvel_small(1) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1, k + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1, k + q, & + dvel_small(2) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1, k + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1, k + q, & & l)/rho_sf_small(-1)) @@ -1753,12 +1753,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j, k + 1 + q, & + dvel_small(1) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb)%sf(j, k + 1 + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1 + q, & + dvel_small(2) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1 + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k - 1 + q, & & l)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + 1 + q, & + dvel_small(3) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + 1 + q, & & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k - 1 + q, & & l)/rho_sf_small(-1)) @@ -1784,10 +1784,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + q, & + dvel_small(2) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + q, & & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k + q, & & l - 1)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + q, & + dvel_small(3) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + q, & & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k + q, & & l - 1)/rho_sf_small(-1)) if (q > vidxb) then @@ -1901,87 +1901,87 @@ contains $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) + & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/y%spacing(k)), kind=stp) end if E_L = 0._wp; E_R = 0._wp @@ -2006,13 +2006,13 @@ contains do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k + 1, l) = rhs_vf(i)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/dy(k)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(2))*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/y%spacing(k)), kind=stp) end do if (num_fluids > 1) then @@ -2020,77 +2020,77 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) + & l)*vel_L(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_L(2)*(1._wp/dy(k)), kind=stp) + & l)*vel_L(2)*(1._wp/y%spacing(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*rho_L*vel_L(3)*vel_L(2)*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*rho_L*vel_L(3)*vel_L(2)*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k + 1)) & - & - 0.5_wp*dt*cfl*(E_L)*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/y%spacing(k + 1)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(rho_L*vel_L(1) & - & )*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_L*vel_L(3)*vel_L(2)*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(rho_L*vel_L(3) & - & )*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*rho_L*vel_L(3)*vel_L(2)*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/y%spacing(k)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/y%spacing(k)), kind=stp) $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k + 1, l) = rhs_vf(i)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/dy(k)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(2))*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/y%spacing(k)), kind=stp) end do if (num_fluids > 1) then @@ -2098,65 +2098,65 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & - & l)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) + & l)*vel_R(2)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l)*vel_R(2)*(1._wp/dy(k)), kind=stp) + & l)*vel_R(2)*(1._wp/y%spacing(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & - & l) + real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k + 1)) & - & + 0.5_wp*dt*cfl*(E_R)*(1._wp/dy(k + 1)), kind=stp) + & l) + real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/y%spacing(k + 1)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/y%spacing(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(rho_R*vel_R(1) & - & )*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(rho_R*vel_R(3) & - & )*(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/y%spacing(k)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dy(k)), kind=stp) + & l) - real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/y%spacing(k)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/y%spacing(k)), kind=stp) end do end do end do @@ -2195,9 +2195,9 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k, & + dvel_small(1) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k, & & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1, k, l + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 2)%sf(j + 1, k, & + dvel_small(3) = (1/(2._wp*x%spacing(j)))*(q_cons_vf(igr_momxb + 2)%sf(j + 1, k, & & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j - 1, k, & & l + q)/rho_sf_small(-1)) @@ -2221,10 +2221,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1, & + dvel_small(2) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1, & & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k - 1, & & l + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + 1, & + dvel_small(3) = (1/(2._wp*y%spacing(k)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + 1, & & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k - 1, & & l + q)/rho_sf_small(-1)) @@ -2247,13 +2247,13 @@ contains end do rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb)%sf(j, k, & + dvel_small(1) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb)%sf(j, k, & & l + 1 + q)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j, k, & & l - 1 + q)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 1)%sf(j, k, & + dvel_small(2) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb + 1)%sf(j, k, & & l + 1 + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k, & & l - 1 + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 2)%sf(j, k, & + dvel_small(3) = (1/(2._wp*z%spacing(l)))*(q_cons_vf(igr_momxb + 2)%sf(j, k, & & l + 1 + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k, & & l - 1 + q)/rho_sf_small(-1)) if (q > vidxb) then @@ -2370,87 +2370,87 @@ contains $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(2)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(2)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(2)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(2)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(2)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(2)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(2)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(2)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(3)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(3)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(3)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(3)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(3)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(3)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(3)*(1._wp/dz(l)), kind=stp) + & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(3)*(1._wp/z%spacing(l)), kind=stp) end if E_L = 0._wp; E_R = 0._wp @@ -2475,13 +2475,13 @@ contains do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l + 1) = rhs_vf(i)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(3))*(1._wp/dz(l + 1)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(3))*(1._wp/z%spacing(l + 1)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(3))*(1._wp/dz(l)) & - & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_rho_L(i)*vel_L(3))*(1._wp/z%spacing(l)) & + & - 0.5_wp*dt*cfl*(alpha_rho_L(i))*(1._wp/z%spacing(l)), kind=stp) end do if (num_fluids > 1) then @@ -2489,77 +2489,77 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(alpha_L(i)*vel_L(3))*(1._wp/dz(l + 1)) & - & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(alpha_L(i)*vel_L(3))*(1._wp/z%spacing(l + 1)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l + 1) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l + 1)*vel_L(3)*(1._wp/dz(l + 1)), kind=stp) + & l + 1)*vel_L(3)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(3))*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(alpha_L(i)) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(3))*(1._wp/z%spacing(l)) & + & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, l)*vel_L(3)*(1._wp/dz(l)), & - & kind=stp) + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_L(3)*(1._wp/z%spacing(l)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(rho_L*(vel_L(3))**2.0 + pres_L + F_L)*(1._wp/dz(l + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(rho_L*(vel_L(3))**2.0 + pres_L + F_L)*(1._wp/z%spacing(l + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dz(l + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/z%spacing(l + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*rho_L*vel_L(2)*vel_L(3)*(1._wp/dz(l + 1)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*rho_L*vel_L(2)*vel_L(3)*(1._wp/z%spacing(l + 1)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(vel_L(3)*(E_L + pres_L + F_L))*(1._wp/dz(l + 1)) & - & - 0.5_wp*dt*cfl*(E_L)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(vel_L(3)*(E_L + pres_L + F_L))*(1._wp/z%spacing(l + 1)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) - real(0.5_wp*dt*(rho_L*(vel_L(3))**2.0 + pres_L + F_L)*(1._wp/dz(l)) & - & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(rho_L*(vel_L(3))**2.0 + pres_L + F_L)*(1._wp/z%spacing(l)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(rho_L*vel_L(1)) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/z%spacing(l)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_L*vel_L(2)*vel_L(3)*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(rho_L*vel_L(2)) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*rho_L*vel_L(2)*vel_L(3)*(1._wp/z%spacing(l)) & + & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*(vel_L(3)*(E_L + pres_L + F_L))*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(E_L) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(vel_L(3)*(E_L + pres_L + F_L))*(1._wp/z%spacing(l)) & + & - 0.5_wp*dt*cfl*(E_L)*(1._wp/z%spacing(l)), kind=stp) $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l + 1) = rhs_vf(i)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(3))*(1._wp/dz(l + 1)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(3))*(1._wp/z%spacing(l + 1)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(3))*(1._wp/dz(l)) & - & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_rho_R(i)*vel_R(3))*(1._wp/z%spacing(l)) & + & + 0.5_wp*dt*cfl*(alpha_rho_R(i))*(1._wp/z%spacing(l)), kind=stp) end do if (num_fluids > 1) then @@ -2567,65 +2567,65 @@ contains do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(alpha_R(i)*vel_R(3))*(1._wp/dz(l + 1)) & - & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(alpha_R(i)*vel_R(3))*(1._wp/z%spacing(l + 1)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l + 1) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & - & l + 1)*vel_R(3)*(1._wp/dz(l + 1)), kind=stp) + & l + 1)*vel_R(3)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(3))*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(alpha_R(i)) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(3))*(1._wp/z%spacing(l)) & + & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, l)*vel_R(3)*(1._wp/dz(l)), & - & kind=stp) + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_R(3)*(1._wp/z%spacing(l)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(rho_R*(vel_R(3))**2.0 + pres_R + F_R)*(1._wp/dz(l + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(rho_R*(vel_R(3))**2.0 + pres_R + F_R)*(1._wp/z%spacing(l + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dz(l + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/z%spacing(l + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dz(l + 1)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/z%spacing(l + 1)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & - & l + 1) + real(0.5_wp*dt*(vel_R(3)*(E_R + pres_R + F_R))*(1._wp/dz(l + 1)) & - & + 0.5_wp*dt*cfl*(E_R)*(1._wp/dz(l + 1)), kind=stp) + & l + 1) + real(0.5_wp*dt*(vel_R(3)*(E_R + pres_R + F_R))*(1._wp/z%spacing(l + 1)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/z%spacing(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & - & l) - real(0.5_wp*dt*(rho_R*(vel_R(3))**2.0 + pres_R + F_R)*(1._wp/dz(l)) & - & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(rho_R*(vel_R(3))**2.0 + pres_R + F_R)*(1._wp/z%spacing(l)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(rho_R*vel_R(1)) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/z%spacing(l)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & - & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(rho_R*vel_R(2)) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/z%spacing(l)) & + & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/z%spacing(l)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & - & l) - real(0.5_wp*dt*(vel_R(3)*(E_R + pres_R + F_R))*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(E_R) & - & *(1._wp/dz(l)), kind=stp) + & l) - real(0.5_wp*dt*(vel_R(3)*(E_R + pres_R + F_R))*(1._wp/z%spacing(l)) & + & + 0.5_wp*dt*cfl*(E_R)*(1._wp/z%spacing(l)), kind=stp) end do end do end do @@ -2691,7 +2691,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(i)%sf(j, k, l) = 1._wp/dx(j)*(flux_vf(i)%sf(j - 1, k, l) - flux_vf(i)%sf(j, k, l)) + rhs_vf(i)%sf(j, k, l) = 1._wp/x%spacing(j)*(flux_vf(i)%sf(j - 1, k, l) - flux_vf(i)%sf(j, k, l)) end do end do end do @@ -2703,7 +2703,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_vf(i)%sf(j, k - 1, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/y%spacing(k)*(flux_vf(i)%sf(j, k - 1, & & l) - flux_vf(i)%sf(j, k, l)) end do end do @@ -2716,7 +2716,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_vf(i)%sf(j, k, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/z%spacing(l)*(flux_vf(i)%sf(j, k, & & l - 1) - flux_vf(i)%sf(j, k, l)) end do end do diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index b3c7cb6f49..1aa7fad220 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -63,8 +63,9 @@ contains call MPI_BCAST(case_dir, len(case_dir), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) - #:for VAR in ['k_x', 'k_y', 'k_z', 'w_x', 'w_y', 'w_z', 'p_x', 'p_y', & - & 'p_z', 'g_x', 'g_y', 'g_z'] + #:for VAR in ['bf_x%k', 'bf_x%w', 'bf_x%p', 'bf_x%g', & + & 'bf_y%k', 'bf_y%w', 'bf_y%p', 'bf_y%g', & + & 'bf_z%k', 'bf_z%w', 'bf_z%p', 'bf_z%g'] call MPI_BCAST(${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor @@ -86,7 +87,7 @@ contains & 'parallel_io', 'hypoelasticity', 'bubbles_euler', 'polytropic', & & 'polydisperse', 'qbmm', 'acoustic_source', 'probe_wrt', 'integral_wrt', & & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & - & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & + & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x%enabled', 'bf_y%enabled', 'bf_z%enabled', & & 'bc_x%grcbc_in', 'bc_x%grcbc_out', 'bc_x%grcbc_vel_out', & & 'bc_y%grcbc_in', 'bc_y%grcbc_out', 'bc_y%grcbc_vel_out', & & 'bc_z%grcbc_in', 'bc_z%grcbc_out', 'bc_z%grcbc_vel_out', & @@ -130,11 +131,12 @@ contains & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & & 'bc_x%pres_in','bc_x%pres_out','bc_y%pres_in','bc_y%pres_out', 'bc_z%pres_in','bc_z%pres_out', & - & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & - & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & - & 'bc_x%Twall_in', 'bc_x%Twall_out', 'bc_y%Twall_in', 'bc_y%Twall_out', & + & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & + & 'z_domain%beg', 'z_domain%end', 'x_stretch%beg', 'x_stretch%end', & + & 'y_stretch%beg', 'y_stretch%end', 'z_stretch%beg', 'z_stretch%end', & + & 'bc_x%Twall_in', 'bc_x%Twall_out', 'bc_y%Twall_in', 'bc_y%Twall_out', & & 'bc_z%Twall_in', 'bc_z%Twall_out', & - & 'z_b', 't_stop', 't_save', 'cfl_target', 'Bx0', 'alf_factor', & + & 't_stop', 't_save', 'cfl_target', 'Bx0', 'alf_factor', & & 'tau_star', 'cont_damage_s', 'alpha_bar', 'adap_dt_tol', & & 'ic_eps', 'ic_beta', 'hyper_cleaning_speed', & & 'hyper_cleaning_tau', 'coefficient_of_restitution', 'collision_time', & diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 9f0fceecdf..3730941e19 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -402,12 +402,11 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: flux_n_vf real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb - real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), & - & intent(inout) :: rhs_pb ! TODO :: I think that this should be stp as well. - - integer :: i, j, k, l, q + ! TODO :: I think that this should be stp as well. + real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: rhs_pb + integer :: i, j, k, l, q real(wp) :: nb_q, nb_dot, R, R2, nR, nR2, nR_dot, nR2_dot, var, AX - logical :: is_axisym + logical :: is_axisym select case (idir) case (1) @@ -446,7 +445,7 @@ contains nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j - 1, k, & & l) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dx(j)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(x%spacing(j)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) case (2) nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k - 1, & & l) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l) @@ -455,7 +454,7 @@ contains nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k - 1, & & l) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dy(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(y%spacing(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) case (3) if (is_axisym) then nb_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & @@ -468,8 +467,8 @@ contains & l)*(flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, & & l - 1) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, & - & q, i)) + & i) - 3._wp*gam/(z%spacing(l)*y%cc(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot) & + & *(pb(j, k, l, q, i)) else nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, & & l - 1) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l) @@ -478,39 +477,40 @@ contains nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, & & l - 1) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dz(l)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(z%spacing(l)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, & + & q, i)) end if end select if (q <= 2) then select case (idir) case (1) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q - nR2*nb_dot) & - & *(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(x%spacing(j)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & + & - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q)*(nR_dot*nb_q & - & - nR*nb_dot))*(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(x%spacing(j)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & + & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) case (2) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q - nR2*nb_dot) & - & *(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(y%spacing(k)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & + & - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q)*(nR_dot*nb_q & - & - nR*nb_dot))*(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(y%spacing(k)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & + & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) case (3) if (is_axisym) then rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & - & - nR2*nb_dot)*(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(z%spacing(l)*y%cc(k)*AX*nb_q**2*sqrt(var)*2._wp) & + & *(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & - & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(z%spacing(l)*y%cc(k)*AX*nb_q**2*sqrt(var)*2._wp) & + & *(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q - nR2*nb_dot) & - & *(pb(j, k, l, q, i)) + & i) + 3._wp*gam/(z%spacing(l)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & + & - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & + & i) + 3._wp*gam/(z%spacing(l)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end select @@ -518,32 +518,32 @@ contains select case (idir) case (1) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q - nR2*nb_dot) & - & *(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(x%spacing(j)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & + & - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q)*(nR_dot*nb_q & - & - nR*nb_dot))*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(x%spacing(j)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & + & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) case (2) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q - nR2*nb_dot) & - & *(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(y%spacing(k)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & + & - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q)*(nR_dot*nb_q & - & - nR*nb_dot))*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(y%spacing(k)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & + & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) case (3) if (is_axisym) then rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & - & - nR2*nb_dot)*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(z%spacing(l)*y%cc(k)*AX*nb_q**2*sqrt(var)*2._wp) & + & *(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & - & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(z%spacing(l)*y%cc(k)*AX*nb_q**2*sqrt(var)*2._wp) & + & *(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q - nR2*nb_dot) & - & *(pb(j, k, l, q, i)) + & i) - 3._wp*gam/(z%spacing(l)*AX*nb_q**2*sqrt(var)*2._wp)*(nR2_dot*nb_q & + & - nR2*nb_dot)*(pb(j, k, l, q, i)) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & - & i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & + & i) - 3._wp*gam/(z%spacing(l)*AX*nb_q**2*sqrt(var)*2._wp)*(-2._wp*(nR/nb_q) & & *(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end select @@ -841,8 +841,8 @@ contains & momrhs(:,i1, i2, j, q)) end if case (2) - if ((j >= 7 .and. j <= 9) .or. (j >= 22 .and. j <= 23) & - & .or. (j >= 10 .and. j <= 11) .or. (j == 26)) then + if ((j >= 7 .and. j <= 9) .or. (j >= 22 .and. j <= 23) .or. (j >= 10 & + & .and. j <= 11) .or. (j == 26)) then momsum = momsum + coeff(j, i1, i2)*(R0(q)**momrhs(3, i1, i2, j, & & q))*f_quad2D(abscX(:,q), abscY(:,q), wght_pb(:,q), & & momrhs(:,i1, i2, j, q)) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 60235675ea..ff02d416cf 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -517,9 +517,8 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: pb_in - real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), & - & intent(inout) & - & :: rhs_pb ! TODO :: I think these other two variables need to be stp as well, but it doesn't compile like that right now + ! TODO :: I think these other two variables need to be stp as well, but it doesn't compile like that right now + real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: rhs_pb real(stp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: mv_in real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:,1:), intent(inout) :: rhs_mv integer, intent(in) :: t_step @@ -530,6 +529,7 @@ contains integer(kind=8) :: i, j, k, l, q !< Generic loop iterators ! RHS: halo exchange -> reconstruct -> Riemann solve -> flux difference -> source terms + call nvtxStartRange("COMPUTE-RHS") call cpu_time(t_start) @@ -940,7 +940,7 @@ contains do q_loop = 0, p do l_loop = 0, n do k_loop = 0, m - inv_ds = 1._wp/dx(k_loop) + inv_ds = 1._wp/x%spacing(k_loop) flux_face1 = flux_n(1)%vf(j)%sf(k_loop - 1, l_loop, q_loop) flux_face2 = flux_n(1)%vf(j)%sf(k_loop, l_loop, q_loop) rhs_vf(j)%sf(k_loop, l_loop, q_loop) = inv_ds*(flux_face1 - flux_face2) @@ -957,7 +957,7 @@ contains do l_loop = 0, n do k_loop = 0, m do i_fluid_loop = 1, num_fluids - inv_ds = 1._wp/dx(k_loop) + inv_ds = 1._wp/x%spacing(k_loop) advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(k_loop, l_loop, q_loop) pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(k_loop, l_loop, q_loop) flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(k_loop, l_loop, q_loop) @@ -986,7 +986,7 @@ contains do l = 0, p do k = 0, n do q = 0, m - inv_ds = 1._wp/dy(k) + inv_ds = 1._wp/y%spacing(k) flux_face1 = flux_n(2)%vf(j)%sf(q, k - 1, l) flux_face2 = flux_n(2)%vf(j)%sf(q, k, l) rhs_vf(j)%sf(q, k, l) = rhs_vf(j)%sf(q, k, l) + inv_ds*(flux_face1 - flux_face2) @@ -1003,7 +1003,7 @@ contains do k = 0, n do q = 0, m do i_fluid_loop = 1, num_fluids - inv_ds = 1._wp/dy(k) + inv_ds = 1._wp/y%spacing(k) advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(q, k, l) pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(q, k, l) flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(q, k, l) @@ -1014,7 +1014,7 @@ contains if (cyl_coord) then rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, & & l) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, & - & l) - 5.e-1_wp/y_cc(k)*advected_qty_val*pressure_val*(flux_face1 + flux_face2) + & l) - 5.e-1_wp/y%cc(k)*advected_qty_val*pressure_val*(flux_face1 + flux_face2) end if end do end do @@ -1031,7 +1031,7 @@ contains do q = 0, m flux_face1 = flux_gsrc_n(2)%vf(j)%sf(q, k - 1, l) flux_face2 = flux_gsrc_n(2)%vf(j)%sf(q, k, l) - rhs_vf(j)%sf(q, k, l) = rhs_vf(j)%sf(q, k, l) - 5.e-1_wp/y_cc(k)*(flux_face1 + flux_face2) + rhs_vf(j)%sf(q, k, l) = rhs_vf(j)%sf(q, k, l) - 5.e-1_wp/y%cc(k)*(flux_face1 + flux_face2) end do end do end do @@ -1054,7 +1054,7 @@ contains do k = 0, p do q = 0, n do l = 0, m - inv_ds = 1._wp/(dz(k)*y_cc(q)) + inv_ds = 1._wp/(z%spacing(k)*y%cc(q)) velocity_val = q_prim_vf%vf(eqn_idx%cont%end + idir)%sf(l, q, k) flux_face1 = flux_n(3)%vf(j)%sf(l, q, k - 1) flux_face2 = flux_n(3)%vf(j)%sf(l, q, k) @@ -1071,7 +1071,7 @@ contains do l = 0, m flux_face1 = flux_gsrc_n(3)%vf(j)%sf(l, q, k - 1) flux_face2 = flux_gsrc_n(3)%vf(j)%sf(l, q, k) - rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) - 5.e-1_wp/y_cc(q)*(flux_face1 + flux_face2) + rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) - 5.e-1_wp/y%cc(q)*(flux_face1 + flux_face2) end do end do end do @@ -1083,7 +1083,7 @@ contains do k = 0, p do q = 0, n do l = 0, m - inv_ds = 1._wp/dz(k) + inv_ds = 1._wp/z%spacing(k) flux_face1 = flux_n(3)%vf(j)%sf(l, q, k - 1) flux_face2 = flux_n(3)%vf(j)%sf(l, q, k) rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) + inv_ds*(flux_face1 - flux_face2) @@ -1101,7 +1101,7 @@ contains do q = 0, n do l = 0, m do i_fluid_loop = 1, num_fluids - inv_ds = 1._wp/dz(k) + inv_ds = 1._wp/z%spacing(k) advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(l, q, k) pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(l, q, k) flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(l, q, k) @@ -1146,7 +1146,7 @@ contains do q_idx = 0, p ! z_extent do l_idx = 0, n ! y_extent do k_idx = 0, m ! x_extent - local_inv_ds = 1._wp/dx(k_idx) + local_inv_ds = 1._wp/x%spacing(k_idx) local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(k_idx, l_idx, q_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx - 1, l_idx, q_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx) @@ -1163,7 +1163,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_q_cons_val, & & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m - local_inv_ds = 1._wp/dx(k_idx) + local_inv_ds = 1._wp/x%spacing(k_idx) local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%end)%sf(k_idx, l_idx, q_idx) local_k_term_val = Kterm_arg(k_idx, l_idx, q_idx) ! Access is safe due to outer alt_soundspeed check local_term_coeff = local_q_cons_val - local_k_term_val @@ -1177,7 +1177,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_q_cons_val, & & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m - local_inv_ds = 1._wp/dx(k_idx) + local_inv_ds = 1._wp/x%spacing(k_idx) local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx) local_k_term_val = Kterm_arg(k_idx, l_idx, q_idx) ! Access is safe local_term_coeff = local_q_cons_val + local_k_term_val @@ -1193,7 +1193,7 @@ contains & local_flux1, local_flux2]') do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m - local_inv_ds = 1._wp/dx(k_idx) + local_inv_ds = 1._wp/x%spacing(k_idx) local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx - 1, l_idx, q_idx) @@ -1205,7 +1205,8 @@ contains end if end if case (2) - ! y-direction: loops q_idx (x), k_idx (y), l_idx (z); sf(q_idx, k_idx, l_idx); dy(k_idx); Kterm(q_idx,k_idx,l_idx) + ! y-direction: loops q_idx (x), k_idx (y), l_idx (z); sf(q_idx, k_idx, l_idx); y%spacing(k_idx); + ! Kterm(q_idx,k_idx,l_idx) use_standard_riemann = (riemann_solver == 1 .or. riemann_solver == 4) if (use_standard_riemann) then $:GPU_PARALLEL_LOOP(collapse=4,private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & @@ -1214,7 +1215,7 @@ contains do l_idx = 0, p ! z_extent do k_idx = 0, n ! y_extent do q_idx = 0, m ! x_extent - local_inv_ds = 1._wp/dy(k_idx) + local_inv_ds = 1._wp/y%spacing(k_idx) local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(q_idx, k_idx, l_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx - 1, l_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx) @@ -1231,7 +1232,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_q_cons_val, & & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m - local_inv_ds = 1._wp/dy(k_idx) + local_inv_ds = 1._wp/y%spacing(k_idx) local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) local_k_term_val = Kterm_arg(q_idx, k_idx, l_idx) ! Access is safe local_term_coeff = local_q_cons_val - local_k_term_val @@ -1241,7 +1242,7 @@ contains & k_idx, l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) if (cyl_coord) then rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, & - & k_idx, l_idx) - (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2) + & k_idx, l_idx) - (local_k_term_val/(2._wp*y%cc(k_idx)))*(local_flux1 + local_flux2) end if end do; end do; end do $:END_GPU_PARALLEL_LOOP() @@ -1249,7 +1250,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_q_cons_val, & & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m - local_inv_ds = 1._wp/dy(k_idx) + local_inv_ds = 1._wp/y%spacing(k_idx) local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) local_k_term_val = Kterm_arg(q_idx, k_idx, l_idx) ! Access is safe local_term_coeff = local_q_cons_val + local_k_term_val @@ -1259,7 +1260,7 @@ contains & k_idx, l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) if (cyl_coord) then rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, & - & k_idx, l_idx) + (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2) + & k_idx, l_idx) + (local_k_term_val/(2._wp*y%cc(k_idx)))*(local_flux1 + local_flux2) end if end do; end do; end do $:END_GPU_PARALLEL_LOOP() @@ -1269,7 +1270,7 @@ contains & local_flux1, local_flux2]') do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m - local_inv_ds = 1._wp/dy(k_idx) + local_inv_ds = 1._wp/y%spacing(k_idx) local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx - 1, l_idx) @@ -1281,7 +1282,8 @@ contains end if end if case (3) - ! z-direction: loops l_idx (x), q_idx (y), k_idx (z); sf(l_idx, q_idx, k_idx); dz(k_idx); Kterm(l_idx,q_idx,k_idx) + ! z-direction: loops l_idx (x), q_idx (y), k_idx (z); sf(l_idx, q_idx, k_idx); z%spacing(k_idx); + ! Kterm(l_idx,q_idx,k_idx) if (grid_geometry == 3) then use_standard_riemann = (riemann_solver == 1) else @@ -1295,7 +1297,7 @@ contains do k_idx = 0, p ! z_extent do q_idx = 0, n ! y_extent do l_idx = 0, m ! x_extent - local_inv_ds = 1._wp/dz(k_idx) + local_inv_ds = 1._wp/z%spacing(k_idx) local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(l_idx, q_idx, k_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx - 1) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx) @@ -1312,7 +1314,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_q_cons_val, & & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m - local_inv_ds = 1._wp/dz(k_idx) + local_inv_ds = 1._wp/z%spacing(k_idx) local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx) local_k_term_val = Kterm_arg(l_idx, q_idx, k_idx) ! Access is safe local_term_coeff = local_q_cons_val - local_k_term_val @@ -1326,7 +1328,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=3, private='[k_idx, l_idx, q_idx, local_inv_ds, local_q_cons_val, & & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m - local_inv_ds = 1._wp/dz(k_idx) + local_inv_ds = 1._wp/z%spacing(k_idx) local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx) local_k_term_val = Kterm_arg(l_idx, q_idx, k_idx) ! Access is safe local_term_coeff = local_q_cons_val + local_k_term_val @@ -1342,7 +1344,7 @@ contains & local_flux1, local_flux2]') do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m - local_inv_ds = 1._wp/dz(k_idx) + local_inv_ds = 1._wp/z%spacing(k_idx) local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx - 1) @@ -1377,8 +1379,9 @@ contains do k = 0, n do j = 0, m rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, & - & l) + 1._wp/dx(j)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & - & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j - 1, k, l)) + & l) + 1._wp/x%spacing(j)*q_prim_vf(eqn_idx%c)%sf(j, k, & + & l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j - 1, k, & + & l)) end do end do end do @@ -1393,21 +1396,23 @@ contains if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_n_in(i)%sf(j - 1, k, & - & l) - flux_src_n_in(i)%sf(j, k, l)) + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & + & l) + 1._wp/x%spacing(j)*(flux_src_n_in(i)%sf(j - 1, k, l) - flux_src_n_in(i)%sf(j, & + & k, l)) end do end if if (chem_params%diffusion) then $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%species%beg, eqn_idx%species%end - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_n_in(i)%sf(j - 1, k, & - & l) - flux_src_n_in(i)%sf(j, k, l)) + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & + & l) + 1._wp/x%spacing(j)*(flux_src_n_in(i)%sf(j - 1, k, l) - flux_src_n_in(i)%sf(j, & + & k, l)) end do if (.not. viscous) then rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & - & l) + 1._wp/dx(j)*(flux_src_n_in(eqn_idx%E)%sf(j - 1, k, & + & l) + 1._wp/x%spacing(j)*(flux_src_n_in(eqn_idx%E)%sf(j - 1, k, & & l) - flux_src_n_in(eqn_idx%E)%sf(j, k, l)) end if end if @@ -1423,8 +1428,9 @@ contains do k = 0, n do j = 0, m rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, & - & l) + 1._wp/dy(k)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & - & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k - 1, l)) + & l) + 1._wp/y%spacing(k)*q_prim_vf(eqn_idx%c)%sf(j, k, & + & l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k - 1, & + & l)) end do end do end do @@ -1448,7 +1454,7 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, 0, l) = rhs_vf(i)%sf(j, 0, l) + 1._wp/(y_cc(1) - y_cc(-1))*(tau_Re_vf(i)%sf(j, & + rhs_vf(i)%sf(j, 0, l) = rhs_vf(i)%sf(j, 0, l) + 1._wp/(y%cc(1) - y%cc(-1))*(tau_Re_vf(i)%sf(j, & & -1, l) - tau_Re_vf(i)%sf(j, 1, l)) end do end do @@ -1462,7 +1468,7 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, k - 1, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/y%spacing(k)*(flux_src_n_in(i)%sf(j, k - 1, & & l) - flux_src_n_in(i)%sf(j, k, l)) end do end do @@ -1478,20 +1484,22 @@ contains if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, & - & k - 1, l) - flux_src_n_in(i)%sf(j, k, l)) + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & + & l) + 1._wp/y%spacing(k)*(flux_src_n_in(i)%sf(j, k - 1, & + & l) - flux_src_n_in(i)%sf(j, k, l)) end do end if if (chem_params%diffusion) then $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%species%beg, eqn_idx%species%end - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, & - & k - 1, l) - flux_src_n_in(i)%sf(j, k, l)) + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, & + & l) + 1._wp/y%spacing(k)*(flux_src_n_in(i)%sf(j, k - 1, & + & l) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & - & l) + 1._wp/dy(k)*(flux_src_n_in(eqn_idx%E)%sf(j, k - 1, & + & l) + 1._wp/y%spacing(k)*(flux_src_n_in(eqn_idx%E)%sf(j, k - 1, & & l) - flux_src_n_in(eqn_idx%E)%sf(j, k, l)) end if end if @@ -1511,7 +1519,7 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_n_in(i)%sf(j, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y%cc(k)*(flux_src_n_in(i)%sf(j, & & k - 1, l) + flux_src_n_in(i)%sf(j, k, l)) end do end do @@ -1525,7 +1533,7 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, 0, l) = rhs_vf(i)%sf(j, 0, l) - 1._wp/y_cc(0)*tau_Re_vf(i)%sf(j, 0, l) + rhs_vf(i)%sf(j, 0, l) = rhs_vf(i)%sf(j, 0, l) - 1._wp/y%cc(0)*tau_Re_vf(i)%sf(j, 0, l) end do end do end do @@ -1538,7 +1546,7 @@ contains do j = 0, m $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_n_in(i)%sf(j, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y%cc(k)*(flux_src_n_in(i)%sf(j, & & k - 1, l) + flux_src_n_in(i)%sf(j, k, l)) end do end do @@ -1554,8 +1562,9 @@ contains do k = 0, n do j = 0, m rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, & - & l) + 1._wp/dz(l)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & - & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, l - 1)) + & l) + 1._wp/z%spacing(l)*q_prim_vf(eqn_idx%c)%sf(j, k, & + & l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & + & l - 1)) end do end do end do @@ -1570,7 +1579,7 @@ contains if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%mom%beg, eqn_idx%E - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_n_in(i)%sf(j, k, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/z%spacing(l)*(flux_src_n_in(i)%sf(j, k, & & l - 1) - flux_src_n_in(i)%sf(j, k, l)) end do end if @@ -1578,12 +1587,12 @@ contains if (chem_params%diffusion) then $:GPU_LOOP(parallelism='[seq]') do i = eqn_idx%species%beg, eqn_idx%species%end - rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_n_in(i)%sf(j, k, & + rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/z%spacing(l)*(flux_src_n_in(i)%sf(j, k, & & l - 1) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & - & l) + 1._wp/dz(l)*(flux_src_n_in(eqn_idx%E)%sf(j, k, & + & l) + 1._wp/z%spacing(l)*(flux_src_n_in(eqn_idx%E)%sf(j, k, & & l - 1) - flux_src_n_in(eqn_idx%E)%sf(j, k, l)) end if end if diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index b5e618438d..546d3d5a19 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -32,8 +32,8 @@ module m_riemann_solvers & s_hlld_riemann_solver, s_lf_riemann_solver, s_finalize_riemann_solvers_module !> The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann problem solver, and the - !! direct evaluation of source terms, by using the left and right states given in qK_prim_rs_vf, dqK_prim_ds_vf where ds = dx, - !! dy or dz. + !! direct evaluation of source terms, by using the left and right states given in qK_prim_rs_vf, dqK_prim_ds_vf where ds = + !! x%spacing, y%spacing or z%spacing. !> @{ real(wp), allocatable, dimension(:,:,:,:) :: flux_rsx_vf, flux_src_rsx_vf real(wp), allocatable, dimension(:,:,:,:) :: flux_rsy_vf, flux_src_rsy_vf @@ -423,11 +423,11 @@ contains pres_mag%R = 0.5_wp*(B%R(1)**2._wp + B%R(2)**2._wp + B%R(3)**2._wp) #:endif E_L = gamma_L*pres_L + pi_inf_L + 0.5_wp*rho_L*vel_L_rms + qv_L + pres_mag%L - E_R = gamma_R*pres_R + pi_inf_R + 0.5_wp*rho_R*vel_R_rms + qv_R & - & + pres_mag%R ! includes magnetic energy + ! includes magnetic energy + E_R = gamma_R*pres_R + pi_inf_R + 0.5_wp*rho_R*vel_R_rms + qv_R + pres_mag%R H_L = (E_L + pres_L - pres_mag%L)/rho_L - H_R = (E_R + pres_R - pres_mag%R) & - & /rho_R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound) + ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound) + H_R = (E_R + pres_R - pres_mag%R)/rho_R else E_L = gamma_L*pres_L + pi_inf_L + 5.e-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5.e-1*rho_R*vel_R_rms + qv_R @@ -720,7 +720,7 @@ contains ! MHD: magnetic flux and Maxwell stress contributions if (mhd) then - if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const. + if (n == 0) then ! 1D: d/x%spacing flux only & Bx = Bx0 = const. ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0 $:GPU_LOOP(parallelism='[seq]') do i = 0, 1 @@ -754,9 +754,8 @@ contains & eqn_idx%psi) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, & & eqn_idx%psi)))/(s_M - s_P) else - flux_rs${XYZ}$_vf(j, k, l, & - & eqn_idx%B%beg + norm_dir - 1) & - & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero + ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp end if end if flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = 0._wp @@ -1113,11 +1112,11 @@ contains pres_mag%L = 0.5_wp*(B%L(1)**2._wp + B%L(2)**2._wp + B%L(3)**2._wp) pres_mag%R = 0.5_wp*(B%R(1)**2._wp + B%R(2)**2._wp + B%R(3)**2._wp) E_L = gamma_L*pres_L + pi_inf_L + 0.5_wp*rho_L*vel_L_rms + qv_L + pres_mag%L - E_R = gamma_R*pres_R + pi_inf_R + 0.5_wp*rho_R*vel_R_rms + qv_R & - & + pres_mag%R ! includes magnetic energy + ! includes magnetic energy + E_R = gamma_R*pres_R + pi_inf_R + 0.5_wp*rho_R*vel_R_rms + qv_R + pres_mag%R H_L = (E_L + pres_L - pres_mag%L)/rho_L - H_R = (E_R + pres_R - pres_mag%R) & - & /rho_R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound) + ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound) + H_R = (E_R + pres_R - pres_mag%R)/rho_R else E_L = gamma_L*pres_L + pi_inf_L + 5.e-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5.e-1*rho_R*vel_R_rms + qv_R @@ -1347,7 +1346,7 @@ contains ! MHD: magnetic flux and Maxwell stress contributions if (mhd) then - if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const. + if (n == 0) then ! 1D: d/x%spacing flux only & Bx = Bx0 = const. ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0 $:GPU_LOOP(parallelism='[seq]') do i = 0, 1 @@ -3474,8 +3473,8 @@ contains E%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L E%R = gamma%R*pres%R + pi_inf%R + 0.5_wp*rho%R*vel_rms%R + qv%R + pres_mag%R ! includes magnetic energy H_no_mag%L = (E%L + pres%L - pres_mag%L)/rho%L - H_no_mag%R = (E%R + pres%R - pres_mag%R) & - & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound) + ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound) + H_no_mag%R = (E%R + pres%R - pres_mag%R)/rho%R ! (2) Compute fast wave speeds call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, H_no_mag%L, alpha_L, vel_rms%L, & @@ -4246,17 +4245,17 @@ contains Re_s = Re_avg_rsx_vf(j, k, l, 1) Re_b = Re_avg_rsx_vf(j, k, l, 2) vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims) - r_eff = y_cc(k) + r_eff = y%cc(k) case (2) ! y-face (radial face in r_cyl direction) Re_s = Re_avg_rsy_vf(k, j, l, 1) Re_b = Re_avg_rsy_vf(k, j, l, 2) vel_src_int = vel_src_rsy_vf(k, j, l,1:num_dims) - r_eff = y_cb(k) + r_eff = y%cb(k) case (3) ! z-face (azimuthal face in theta_cyl direction) Re_s = Re_avg_rsz_vf(l, k, j, 1) Re_b = Re_avg_rsz_vf(l, k, j, 2) vel_src_int = vel_src_rsz_vf(l, k, j,1:num_dims) - r_eff = y_cc(k) + r_eff = y%cc(k) end select ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl) diff --git a/src/simulation/m_sim_helpers.fpp b/src/simulation/m_sim_helpers.fpp index 4a0978919e..edc173b862 100644 --- a/src/simulation/m_sim_helpers.fpp +++ b/src/simulation/m_sim_helpers.fpp @@ -28,12 +28,12 @@ contains if (grid_geometry == 3) then if (k == 0) then - fltr_dtheta = 2._wp*pi*y_cb(0)/3._wp + fltr_dtheta = 2._wp*pi*y%cb(0)/3._wp else if (k <= fourier_rings) then Nfq = min(floor(2._wp*real(k, wp)*pi), (p + 1)/2 + 1) - fltr_dtheta = 2._wp*pi*y_cb(k - 1)/real(Nfq, wp) + fltr_dtheta = 2._wp*pi*y%cb(k - 1)/real(Nfq, wp) else - fltr_dtheta = y_cb(k - 1)*dz(l) + fltr_dtheta = y%cb(k - 1)*z%spacing(l) end if else fltr_dtheta = 0._wp @@ -57,14 +57,14 @@ contains ! 3D #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (grid_geometry == 3) then - cfl_terms = min(dx(j)/(abs(vel(1)) + c), dy(k)/(abs(vel(2)) + c), fltr_dtheta/(abs(vel(3)) + c)) + cfl_terms = min(x%spacing(j)/(abs(vel(1)) + c), y%spacing(k)/(abs(vel(2)) + c), fltr_dtheta/(abs(vel(3)) + c)) else - cfl_terms = min(dx(j)/(abs(vel(1)) + c), dy(k)/(abs(vel(2)) + c), dz(l)/(abs(vel(3)) + c)) + cfl_terms = min(x%spacing(j)/(abs(vel(1)) + c), y%spacing(k)/(abs(vel(2)) + c), z%spacing(l)/(abs(vel(3)) + c)) end if #:endif else ! 2D - cfl_terms = min(dx(j)/(abs(vel(1)) + c), dy(k)/(abs(vel(2)) + c)) + cfl_terms = min(x%spacing(j)/(abs(vel(1)) + c), y%spacing(k)/(abs(vel(2)) + c)) end if end function f_compute_multidim_cfl_terms @@ -155,7 +155,7 @@ contains icfl_sf(j, k, l) = dt/f_compute_multidim_cfl_terms(vel, c, j, k, l) else ! 1D - icfl_sf(j, k, l) = (dt/dx(j))*(abs(vel(1)) + c) + icfl_sf(j, k, l) = (dt/x%spacing(j))*(abs(vel(1)) + c) end if ! Viscous calculations @@ -165,23 +165,23 @@ contains ! 3D if (grid_geometry == 3) then fltr_dtheta = f_compute_filtered_dtheta(k, l) - vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(dx(j), dy(k), fltr_dtheta)**2._wp - Rc_sf(j, k, l) = min(dx(j)*(abs(vel(1)) + c), dy(k)*(abs(vel(2)) + c), & + vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(x%spacing(j), y%spacing(k), fltr_dtheta)**2._wp + Rc_sf(j, k, l) = min(x%spacing(j)*(abs(vel(1)) + c), y%spacing(k)*(abs(vel(2)) + c), & & fltr_dtheta*(abs(vel(3)) + c))/maxval(1._wp/Re_l) else - vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(dx(j), dy(k), dz(l))**2._wp - Rc_sf(j, k, l) = min(dx(j)*(abs(vel(1)) + c), dy(k)*(abs(vel(2)) + c), & - & dz(l)*(abs(vel(3)) + c))/maxval(1._wp/Re_l) + vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(x%spacing(j), y%spacing(k), z%spacing(l))**2._wp + Rc_sf(j, k, l) = min(x%spacing(j)*(abs(vel(1)) + c), y%spacing(k)*(abs(vel(2)) + c), & + & z%spacing(l)*(abs(vel(3)) + c))/maxval(1._wp/Re_l) end if #:endif else if (n > 0) then ! 2D - vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(dx(j), dy(k))**2._wp - Rc_sf(j, k, l) = min(dx(j)*(abs(vel(1)) + c), dy(k)*(abs(vel(2)) + c))/maxval(1._wp/Re_l) + vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(x%spacing(j), y%spacing(k))**2._wp + Rc_sf(j, k, l) = min(x%spacing(j)*(abs(vel(1)) + c), y%spacing(k)*(abs(vel(2)) + c))/maxval(1._wp/Re_l) else ! 1D - vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/dx(j)**2._wp - Rc_sf(j, k, l) = dx(j)*(abs(vel(1)) + c)/maxval(1._wp/Re_l) + vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/x%spacing(j)**2._wp + Rc_sf(j, k, l) = x%spacing(j)*(abs(vel(1)) + c)/maxval(1._wp/Re_l) end if end if @@ -205,7 +205,7 @@ contains icfl_dt = cfl_target*f_compute_multidim_cfl_terms(vel, c, j, k, l) else ! 1D case - icfl_dt = cfl_target*(dx(j)/(abs(vel(1)) + c)) + icfl_dt = cfl_target*(x%spacing(j)/(abs(vel(1)) + c)) end if ! Viscous calculations @@ -214,16 +214,16 @@ contains ! 3D if (grid_geometry == 3) then fltr_dtheta = f_compute_filtered_dtheta(k, l) - vcfl_dt = cfl_target*(min(dx(j), dy(k), fltr_dtheta)**2._wp)/maxval(1/(rho*Re_l)) + vcfl_dt = cfl_target*(min(x%spacing(j), y%spacing(k), fltr_dtheta)**2._wp)/maxval(1/(rho*Re_l)) else - vcfl_dt = cfl_target*(min(dx(j), dy(k), dz(l))**2._wp)/maxval(1/(rho*Re_l)) + vcfl_dt = cfl_target*(min(x%spacing(j), y%spacing(k), z%spacing(l))**2._wp)/maxval(1/(rho*Re_l)) end if else if (n > 0) then ! 2D - vcfl_dt = cfl_target*(min(dx(j), dy(k))**2._wp)/maxval((1/Re_l)/rho) + vcfl_dt = cfl_target*(min(x%spacing(j), y%spacing(k))**2._wp)/maxval((1/Re_l)/rho) else ! 1D - vcfl_dt = cfl_target*(dx(j)**2._wp)/maxval(1/(rho*Re_l)) + vcfl_dt = cfl_target*(x%spacing(j)**2._wp)/maxval(1/(rho*Re_l)) end if end if diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 65cc825e40..3e8c99e84d 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -88,7 +88,7 @@ contains rdma_mpi, teno_CT, mp_weno, weno_avg, & riemann_solver, low_Mach, wave_speeds, avg_state, & bc_x, bc_y, bc_z, & - x_a, y_a, z_a, x_b, y_b, z_b, & + x_stretch, y_stretch, z_stretch, & x_domain, y_domain, z_domain, & hypoelasticity, & ib, num_ibs, patch_ib, & @@ -108,11 +108,11 @@ contains #:endif Ca, Web, Re_inv, acoustic_source, acoustic, num_source, polytropic, thermal, integral, integral_wrt, num_integrals, & & polydisperse, poly_sigma, qbmm, relax, relax_model, palpha_eps, ptgalpha_eps, file_per_process, sigma, pi_fac, & - & adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, bf_x, bf_y, bf_z, k_x, k_y, k_z, w_x, w_y, w_z, p_x, p_y, p_z, g_x, & - & g_y, g_z, n_start, t_save, t_stop, cfl_adap_dt, cfl_const_dt, cfl_target, surface_tension, bubbles_lagrange, & - & lag_params, hyperelasticity, R0ref, num_bc_patches, Bx0, cont_damage, tau_star, cont_damage_s, alpha_bar, & - & hyper_cleaning, hyper_cleaning_speed, hyper_cleaning_tau, alf_factor, num_igr_iters, num_igr_warm_start_iters, & - & int_comp, ic_eps, ic_beta, nv_uvm_out_of_core, nv_uvm_igr_temps_on_gpu, nv_uvm_pref_gpu, down_sample, fft_wrt + & adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, bf_x, bf_y, bf_z, n_start, t_save, t_stop, cfl_adap_dt, & + & cfl_const_dt, cfl_target, surface_tension, bubbles_lagrange, lag_params, hyperelasticity, R0ref, num_bc_patches, & + & Bx0, cont_damage, tau_star, cont_damage_s, alpha_bar, hyper_cleaning, hyper_cleaning_speed, hyper_cleaning_tau, & + & alf_factor, num_igr_iters, num_igr_warm_start_iters, int_comp, ic_eps, ic_beta, nv_uvm_out_of_core, & + & nv_uvm_igr_temps_on_gpu, nv_uvm_pref_gpu, down_sample, fft_wrt inquire (FILE=trim(file_path), EXIST=file_exist) @@ -129,7 +129,7 @@ contains close (1) - if ((bf_x) .or. (bf_y) .or. (bf_z)) then + if (bf_x%enabled .or. bf_y%enabled .or. bf_z%enabled) then bodyForces = .true. end if @@ -203,19 +203,19 @@ contains if (file_exist) then open (2, FILE=trim(file_path), form='unformatted', ACTION='read', STATUS='old') - read (2) x_cb(-1:m); close (2) + read (2) x%cb(-1:m); close (2) else call s_mpi_abort(trim(file_path) // ' is missing. Exiting.') end if - dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp + x%spacing(0:m) = x%cb(0:m) - x%cb(-1:m - 1) + x%cc(0:m) = x%cb(-1:m - 1) + x%spacing(0:m)/2._wp if (ib) then do i = 1, num_ibs if (patch_ib(i)%c > 0) then - Np = int((patch_ib(i)%p*patch_ib(i)%c/dx(0))*20) + int(((patch_ib(i)%c - patch_ib(i)%p*patch_ib(i)%c)/dx(0)) & - & *20) + 1 + Np = int((patch_ib(i)%p*patch_ib(i)%c/x%spacing(0))*20) + int(((patch_ib(i)%c - patch_ib(i)%p*patch_ib(i)%c) & + & /x%spacing(0))*20) + 1 end if end do end if @@ -227,13 +227,13 @@ contains if (file_exist) then open (2, FILE=trim(file_path), form='unformatted', ACTION='read', STATUS='old') - read (2) y_cb(-1:n); close (2) + read (2) y%cb(-1:n); close (2) else call s_mpi_abort(trim(file_path) // ' is missing. Exiting.') end if - dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp + y%spacing(0:n) = y%cb(0:n) - y%cb(-1:n - 1) + y%cc(0:n) = y%cb(-1:n - 1) + y%spacing(0:n)/2._wp end if if (p > 0) then @@ -243,13 +243,13 @@ contains if (file_exist) then open (2, FILE=trim(file_path), form='unformatted', ACTION='read', STATUS='old') - read (2) z_cb(-1:p); close (2) + read (2) z%cb(-1:p); close (2) else call s_mpi_abort(trim(file_path) // ' is missing. Exiting.') end if - dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp + z%spacing(0:p) = z%cb(0:p) - z%cb(-1:p - 1) + z%cc(0:p) = z%cb(-1:p - 1) + z%spacing(0:p)/2._wp end if do i = 1, sys_size @@ -344,15 +344,15 @@ contains call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.') end if - x_cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) - dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp + x%cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) + x%spacing(0:m) = x%cb(0:m) - x%cb(-1:m - 1) + x%cc(0:m) = x%cb(-1:m - 1) + x%spacing(0:m)/2._wp if (ib) then do i = 1, num_ibs if (patch_ib(i)%c > 0) then - Np = int((patch_ib(i)%p*patch_ib(i)%c/dx(0))*20) + int(((patch_ib(i)%c - patch_ib(i)%p*patch_ib(i)%c)/dx(0)) & - & *20) + 1 + Np = int((patch_ib(i)%p*patch_ib(i)%c/x%spacing(0))*20) + int(((patch_ib(i)%c - patch_ib(i)%p*patch_ib(i)%c) & + & /x%spacing(0))*20) + 1 allocate (MPI_IO_airfoil_IB_DATA%var(1:2*Np)) end if end do @@ -371,9 +371,9 @@ contains call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting.') end if - y_cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) - dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp + y%cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) + y%spacing(0:n) = y%cb(0:n) - y%cb(-1:n - 1) + y%cc(0:n) = y%cb(-1:n - 1) + y%spacing(0:n)/2._wp if (p > 0) then file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'z_cb.dat' @@ -388,9 +388,9 @@ contains call s_mpi_abort('File ' // trim(file_loc) // 'is missing. Exiting.') end if - z_cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) - dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp + z%cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) + z%spacing(0:p) = z%cb(0:p) - z%cb(-1:p - 1) + z%cc(0:p) = z%cb(-1:p - 1) + z%spacing(0:p)/2._wp end if end if @@ -1068,7 +1068,7 @@ contains $:GPU_UPDATE(device='[acoustic_source, num_source]') $:GPU_UPDATE(device='[sigma, surface_tension]') - $:GPU_UPDATE(device='[dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc]') + $:GPU_UPDATE(device='[x%spacing, y%spacing, z%spacing, x%cb, x%cc, y%cb, y%cc, z%cb, z%cc]') $:GPU_UPDATE(device='[bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end]') $:GPU_UPDATE(device='[bc_x%vb1, bc_x%vb2, bc_x%vb3, bc_x%ve1, bc_x%ve2, bc_x%ve3]') $:GPU_UPDATE(device='[bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3]') diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 9a4d0c6425..60822e3505 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -237,7 +237,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(1)%sf(j, k, l) = 1._wp/(x_cc(j + 1) - x_cc(j - 1))*(q_prim_vf(eqn_idx%c)%sf(j + 1, k, & + c_divs(1)%sf(j, k, l) = 1._wp/(x%cc(j + 1) - x%cc(j - 1))*(q_prim_vf(eqn_idx%c)%sf(j + 1, k, & & l) - q_prim_vf(eqn_idx%c)%sf(j - 1, k, l)) end do end do @@ -248,7 +248,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(2)%sf(j, k, l) = 1._wp/(y_cc(k + 1) - y_cc(k - 1))*(q_prim_vf(eqn_idx%c)%sf(j, k + 1, & + c_divs(2)%sf(j, k, l) = 1._wp/(y%cc(k + 1) - y%cc(k - 1))*(q_prim_vf(eqn_idx%c)%sf(j, k + 1, & & l) - q_prim_vf(eqn_idx%c)%sf(j, k - 1, l)) end do end do @@ -260,7 +260,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(3)%sf(j, k, l) = 1._wp/(z_cc(l + 1) - z_cc(l - 1))*(q_prim_vf(eqn_idx%c)%sf(j, k, & + c_divs(3)%sf(j, k, l) = 1._wp/(z%cc(l + 1) - z%cc(l - 1))*(q_prim_vf(eqn_idx%c)%sf(j, k, & & l + 1) - q_prim_vf(eqn_idx%c)%sf(j, k, l - 1)) end do end do diff --git a/src/simulation/m_thinc.fpp b/src/simulation/m_thinc.fpp index a52ec19d76..0ba9d89263 100644 --- a/src/simulation/m_thinc.fpp +++ b/src/simulation/m_thinc.fpp @@ -242,18 +242,18 @@ contains if (ac >= ic_eps .and. ac <= 1._wp - ic_eps) then nr_x = (v_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) - v_vf(eqn_idx%adv%beg)%sf(j - 1, k, & - & l))*(x_cb(j) - x_cb(j - 1))/(x_cc(j + 1) - x_cc(j - 1)) + & l))*(x%cb(j) - x%cb(j - 1))/(x%cc(j + 1) - x%cc(j - 1)) nr_y = 0._wp if (n > 0) then nr_y = (v_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) - v_vf(eqn_idx%adv%beg)%sf(j, k - 1, & - & l))*(y_cb(k) - y_cb(k - 1))/(y_cc(k + 1) - y_cc(k - 1)) + & l))*(y%cb(k) - y%cb(k - 1))/(y%cc(k + 1) - y%cc(k - 1)) end if nr_z = 0._wp if (p > 0) then nr_z = (v_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) - v_vf(eqn_idx%adv%beg)%sf(j, k, & - & l - 1))*(z_cb(l) - z_cb(l - 1))/(z_cc(l + 1) - z_cc(l - 1)) + & l - 1))*(z%cb(l) - z%cb(l - 1))/(z%cc(l + 1) - z%cc(l - 1)) end if nmag = sqrt(nr_x*nr_x + nr_y*nr_y + nr_z*nr_z) @@ -305,7 +305,7 @@ contains real(wp) :: nh1, nh2, nh3, d_local, rho1, rho2 real(wp) :: rho_b, rho_e - #:for REC_DIR, XYZ, CC_PRI in [(1, 'x', 'x_cc'), (2, 'y', 'y_cc'), (3, 'z', 'z_cc')] + #:for REC_DIR, XYZ, CC_PRI in [(1, 'x', 'x%cc'), (2, 'y', 'y%cc'), (3, 'z', 'z%cc')] if (recon_dir == ${REC_DIR}$) then $:GPU_PARALLEL_LOOP(collapse=3,private='[j, k, l, ix, iy, iz, aCL, aC, aCR, aTHINC, moncon, sgn, qmin, qmax, A, & & B, C, beta_eff, nh1, nh2, nh3, d_local, rho1, rho2, rho_b, rho_e]') diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index ce0ae48c4b..130053fce5 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -130,8 +130,8 @@ contains pool_dims(4) = sys_size pool_starts(4) = 1 #ifdef MFC_MIXED_PRECISION - pool_size = 1_8*(idwbuff(1)%end - idwbuff(1)%beg + 1)*(idwbuff(2)%end - idwbuff(2)%beg + 1)*(idwbuff(3)%end - idwbuff(3) & - & %beg + 1)*sys_size + pool_size = 1_8*(idwbuff(1)%end - idwbuff(1)%beg + 1)*(idwbuff(2)%end - idwbuff(2)%beg + 1)*(idwbuff(3)%end & + & - idwbuff(3)%beg + 1)*sys_size call hipCheck(hipMalloc_(cptr_device, pool_size*2_8)) call c_f_pointer(cptr_device, q_cons_ts_pool_device, shape=pool_dims) q_cons_ts_pool_device(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:) => q_cons_ts_pool_device @@ -748,8 +748,8 @@ contains & 3)*dt*patch_ib(i)%torque/rk_coef(s, 4)) ! add the torque to the angular momentum call s_compute_moment_of_inertia(i, patch_ib(i)%angular_vel) ! update the moment of inertia to be based on the direction of the angular momentum - patch_ib(i)%angular_vel = patch_ib(i)%angular_vel/patch_ib(i) & - & %moment ! convert back to angular velocity with the new moment of inertia + ! convert back to angular velocity with the new moment of inertia + patch_ib(i)%angular_vel = patch_ib(i)%angular_vel/patch_ib(i)%moment end if ! Update the angle of the IB diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index dfa32e5c98..f6dc194579 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -43,7 +43,7 @@ contains end subroutine s_initialize_viscous_module - !> Compute viscous stress tensor near cylindrical axis, avoiding 1/r singularity at y_cb(-1)=0 + !> Compute viscous stress tensor near cylindrical axis, avoiding 1/r singularity at y%cb(-1)=0 subroutine s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, grad_x_vf, grad_y_vf, grad_z_vf, tau_Re_vf, ix, iy, iz) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf @@ -166,7 +166,7 @@ contains tau_Re(2, 1) = (grad_y_vf(1)%sf(j, k, l) + grad_x_vf(2)%sf(j, k, l))/Re_visc(1) tau_Re(2, 2) = (4._wp*grad_y_vf(2)%sf(j, k, l) - 2._wp*grad_x_vf(1)%sf(j, k, & - & l) - 2._wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/y_cc(k))/(3._wp*Re_visc(1)) + & l) - 2._wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/y%cc(k))/(3._wp*Re_visc(1)) ! Viscous flux contribution to momentum and energy equations $:GPU_LOOP(parallelism='[seq]') do i = 1, 2 @@ -266,7 +266,7 @@ contains end if tau_Re(2, 2) = (grad_x_vf(1)%sf(j, k, l) + grad_y_vf(2)%sf(j, k, & - & l) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/y_cc(k))/Re_visc(2) + & l) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/y%cc(k))/Re_visc(2) tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) - tau_Re(2, 2) @@ -362,10 +362,10 @@ contains end if end if - tau_Re(2, 2) = -(2._wp/3._wp)*grad_z_vf(3)%sf(j, k, l)/y_cc(k)/Re_visc(1) + tau_Re(2, 2) = -(2._wp/3._wp)*grad_z_vf(3)%sf(j, k, l)/y%cc(k)/Re_visc(1) tau_Re(2, 3) = ((grad_z_vf(2)%sf(j, k, l) - q_prim_vf(eqn_idx%mom%end)%sf(j, k, & - & l))/y_cc(k) + grad_y_vf(3)%sf(j, k, l))/Re_visc(1) + & l))/y%cc(k) + grad_y_vf(3)%sf(j, k, l))/Re_visc(1) $:GPU_LOOP(parallelism='[seq]') do i = 2, 3 @@ -462,7 +462,7 @@ contains end if end if - tau_Re(2, 2) = grad_z_vf(3)%sf(j, k, l)/y_cc(k)/Re_visc(2) + tau_Re(2, 2) = grad_z_vf(3)%sf(j, k, l)/y%cc(k)/Re_visc(2) tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) - tau_Re(2, 2) @@ -510,15 +510,15 @@ contains do i = 1, num_dims if (i == 1) then call s_apply_scalar_divergence_theorem(qL_prim(i)%vf(iv%beg:iv%end), qR_prim(i)%vf(iv%beg:iv%end), & - & dq_prim_dx_qp(1)%vf(iv%beg:iv%end), i, ix, iy, iz, iv, dx, m, & + & dq_prim_dx_qp(1)%vf(iv%beg:iv%end), i, ix, iy, iz, iv, x%spacing, m, & & buff_size) else if (i == 2) then call s_apply_scalar_divergence_theorem(qL_prim(i)%vf(iv%beg:iv%end), qR_prim(i)%vf(iv%beg:iv%end), & - & dq_prim_dy_qp(1)%vf(iv%beg:iv%end), i, ix, iy, iz, iv, dy, n, & + & dq_prim_dy_qp(1)%vf(iv%beg:iv%end), i, ix, iy, iz, iv, y%spacing, n, & & buff_size) else call s_apply_scalar_divergence_theorem(qL_prim(i)%vf(iv%beg:iv%end), qR_prim(i)%vf(iv%beg:iv%end), & - & dq_prim_dz_qp(1)%vf(iv%beg:iv%end), i, ix, iy, iz, iv, dz, p, & + & dq_prim_dz_qp(1)%vf(iv%beg:iv%end), i, ix, iy, iz, iv, z%spacing, p, & & buff_size) end if end do @@ -537,7 +537,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = iv%beg, iv%end dqL_prim_dx_n(1)%vf(i)%sf(j, k, l) = (q_prim_qp%vf(i)%sf(j, k, l) - q_prim_qp%vf(i)%sf(j - 1, k, & - & l))/(x_cc(j) - x_cc(j - 1)) + & l))/(x%cc(j) - x%cc(j - 1)) end do end do end do @@ -551,7 +551,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = iv%beg, iv%end dqR_prim_dx_n(1)%vf(i)%sf(j, k, l) = (q_prim_qp%vf(i)%sf(j + 1, k, l) - q_prim_qp%vf(i)%sf(j, k, & - & l))/(x_cc(j + 1) - x_cc(j)) + & l))/(x%cc(j + 1) - x%cc(j)) end do end do end do @@ -567,7 +567,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = iv%beg, iv%end dqL_prim_dy_n(2)%vf(i)%sf(k, j, l) = (q_prim_qp%vf(i)%sf(k, j, l) - q_prim_qp%vf(i)%sf(k, & - & j - 1, l))/(y_cc(j) - y_cc(j - 1)) + & j - 1, l))/(y%cc(j) - y%cc(j - 1)) end do end do end do @@ -581,7 +581,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = iv%beg, iv%end dqR_prim_dy_n(2)%vf(i)%sf(k, j, l) = (q_prim_qp%vf(i)%sf(k, j + 1, l) - q_prim_qp%vf(i)%sf(k, & - & j, l))/(y_cc(j + 1) - y_cc(j)) + & j, l))/(y%cc(j + 1) - y%cc(j)) end do end do end do @@ -666,7 +666,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = iv%beg, iv%end dqL_prim_dz_n(3)%vf(i)%sf(k, l, j) = (q_prim_qp%vf(i)%sf(k, l, j) - q_prim_qp%vf(i)%sf(k, & - & l, j - 1))/(z_cc(j) - z_cc(j - 1)) + & l, j - 1))/(z%cc(j) - z%cc(j - 1)) end do end do end do @@ -680,7 +680,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = iv%beg, iv%end dqR_prim_dz_n(3)%vf(i)%sf(k, l, j) = (q_prim_qp%vf(i)%sf(k, l, & - & j + 1) - q_prim_qp%vf(i)%sf(k, l, j))/(z_cc(j + 1) - z_cc(j)) + & j + 1) - q_prim_qp%vf(i)%sf(k, l, j))/(z%cc(j + 1) - z%cc(j)) end do end do end do @@ -1158,7 +1158,7 @@ contains do l = is3_viscous%beg, is3_viscous%end do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end - grad_x%sf(j, k, l) = (var%sf(j + 1, k, l) - var%sf(j - 1, k, l))/(x_cc(j + 1) - x_cc(j - 1)) + grad_x%sf(j, k, l) = (var%sf(j + 1, k, l) - var%sf(j - 1, k, l))/(x%cc(j + 1) - x%cc(j - 1)) end do end do end do @@ -1169,7 +1169,7 @@ contains do l = is3_viscous%beg, is3_viscous%end do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end - grad_y%sf(j, k, l) = (var%sf(j, k + 1, l) - var%sf(j, k - 1, l))/(y_cc(k + 1) - y_cc(k - 1)) + grad_y%sf(j, k, l) = (var%sf(j, k + 1, l) - var%sf(j, k - 1, l))/(y%cc(k + 1) - y%cc(k - 1)) end do end do end do @@ -1181,7 +1181,7 @@ contains do l = is3_viscous%beg, is3_viscous%end do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end - grad_z%sf(j, k, l) = (var%sf(j, k, l + 1) - var%sf(j, k, l - 1))/(z_cc(l + 1) - z_cc(l - 1)) + grad_z%sf(j, k, l) = (var%sf(j, k, l + 1) - var%sf(j, k, l - 1))/(z%cc(l + 1) - z%cc(l - 1)) end do end do end do @@ -1192,9 +1192,9 @@ contains do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end grad_x%sf(idwbuff(1)%beg, k, l) = (-3._wp*var%sf(idwbuff(1)%beg, k, l) + 4._wp*var%sf(idwbuff(1)%beg + 1, k, & - & l) - var%sf(idwbuff(1)%beg + 2, k, l))/(x_cc(idwbuff(1)%beg + 2) - x_cc(idwbuff(1)%beg)) + & l) - var%sf(idwbuff(1)%beg + 2, k, l))/(x%cc(idwbuff(1)%beg + 2) - x%cc(idwbuff(1)%beg)) grad_x%sf(idwbuff(1)%end, k, l) = (+3._wp*var%sf(idwbuff(1)%end, k, l) - 4._wp*var%sf(idwbuff(1)%end - 1, k, & - & l) + var%sf(idwbuff(1)%end - 2, k, l))/(x_cc(idwbuff(1)%end) - x_cc(idwbuff(1)%end - 2)) + & l) + var%sf(idwbuff(1)%end - 2, k, l))/(x%cc(idwbuff(1)%end) - x%cc(idwbuff(1)%end - 2)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1203,9 +1203,9 @@ contains do l = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_y%sf(j, idwbuff(2)%beg, l) = (-3._wp*var%sf(j, idwbuff(2)%beg, l) + 4._wp*var%sf(j, idwbuff(2)%beg + 1, & - & l) - var%sf(j, idwbuff(2)%beg + 2, l))/(y_cc(idwbuff(2)%beg + 2) - y_cc(idwbuff(2)%beg)) + & l) - var%sf(j, idwbuff(2)%beg + 2, l))/(y%cc(idwbuff(2)%beg + 2) - y%cc(idwbuff(2)%beg)) grad_y%sf(j, idwbuff(2)%end, l) = (+3._wp*var%sf(j, idwbuff(2)%end, l) - 4._wp*var%sf(j, idwbuff(2)%end - 1, & - & l) + var%sf(j, idwbuff(2)%end - 2, l))/(y_cc(idwbuff(2)%end) - y_cc(idwbuff(2)%end - 2)) + & l) + var%sf(j, idwbuff(2)%end - 2, l))/(y%cc(idwbuff(2)%end) - y%cc(idwbuff(2)%end - 2)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1215,10 +1215,10 @@ contains do j = idwbuff(1)%beg, idwbuff(1)%end grad_z%sf(j, k, idwbuff(3)%beg) = (-3._wp*var%sf(j, k, idwbuff(3)%beg) + 4._wp*var%sf(j, k, & & idwbuff(3)%beg + 1) - var%sf(j, k, & - & idwbuff(3)%beg + 2))/(z_cc(idwbuff(3)%beg + 2) - z_cc(is3_viscous%beg)) + & idwbuff(3)%beg + 2))/(z%cc(idwbuff(3)%beg + 2) - z%cc(is3_viscous%beg)) grad_z%sf(j, k, idwbuff(3)%end) = (+3._wp*var%sf(j, k, idwbuff(3)%end) - 4._wp*var%sf(j, k, & & idwbuff(3)%end - 1) + var%sf(j, k, & - & idwbuff(3)%end - 2))/(z_cc(idwbuff(3)%end) - z_cc(idwbuff(3)%end - 2)) + & idwbuff(3)%end - 2))/(z%cc(idwbuff(3)%end) - z%cc(idwbuff(3)%end - 2)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1229,7 +1229,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=2) do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end - grad_x%sf(0, k, l) = (-3._wp*var%sf(0, k, l) + 4._wp*var%sf(1, k, l) - var%sf(2, k, l))/(x_cc(2) - x_cc(0)) + grad_x%sf(0, k, l) = (-3._wp*var%sf(0, k, l) + 4._wp*var%sf(1, k, l) - var%sf(2, k, l))/(x%cc(2) - x%cc(0)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1239,7 +1239,7 @@ contains do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end grad_x%sf(m, k, l) = (3._wp*var%sf(m, k, l) - 4._wp*var%sf(m - 1, k, l) + var%sf(m - 2, k, & - & l))/(x_cc(m) - x_cc(m - 2)) + & l))/(x%cc(m) - x%cc(m - 2)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1249,7 +1249,7 @@ contains $:GPU_PARALLEL_LOOP(collapse=2) do l = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(1)%beg, idwbuff(1)%end - grad_y%sf(j, 0, l) = (-3._wp*var%sf(j, 0, l) + 4._wp*var%sf(j, 1, l) - var%sf(j, 2, l))/(y_cc(2) - y_cc(0)) + grad_y%sf(j, 0, l) = (-3._wp*var%sf(j, 0, l) + 4._wp*var%sf(j, 1, l) - var%sf(j, 2, l))/(y%cc(2) - y%cc(0)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1259,7 +1259,7 @@ contains do l = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_y%sf(j, n, l) = (3._wp*var%sf(j, n, l) - 4._wp*var%sf(j, n - 1, l) + var%sf(j, n - 2, & - & l))/(y_cc(n) - y_cc(n - 2)) + & l))/(y%cc(n) - y%cc(n - 2)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1270,7 +1270,7 @@ contains do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_z%sf(j, k, 0) = (-3._wp*var%sf(j, k, 0) + 4._wp*var%sf(j, k, 1) - var%sf(j, k, & - & 2))/(z_cc(2) - z_cc(0)) + & 2))/(z%cc(2) - z%cc(0)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1280,7 +1280,7 @@ contains do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_z%sf(j, k, p) = (3._wp*var%sf(j, k, p) - 4._wp*var%sf(j, k, p - 1) + var%sf(j, k, & - & p - 2))/(z_cc(p) - z_cc(p - 2)) + & p - 2))/(z%cc(p) - z%cc(p - 2)) end do end do $:END_GPU_PARALLEL_LOOP() @@ -1300,31 +1300,31 @@ contains real(wp), intent(in) :: dynamic_viscosity integer, intent(in) :: i, j, k real(wp), dimension(1:3,1:3) :: velocity_gradient_tensor - real(wp), dimension(1:3) :: dx + real(wp), dimension(1:3) :: ds real(wp) :: divergence integer :: l, q !< iterators ! zero the viscous stress, collection of velocity derivatives, and spatial finite differences viscous_stress_tensor = 0._wp velocity_gradient_tensor = 0._wp - dx = 0._wp + ds = 0._wp ! get the change in x used in the finite difference equation - dx(1) = 0.5_wp*(x_cc(i + 1) - x_cc(i - 1)) - dx(2) = 0.5_wp*(y_cc(j + 1) - y_cc(j - 1)) + ds(1) = 0.5_wp*(x%cc(i + 1) - x%cc(i - 1)) + ds(2) = 0.5_wp*(y%cc(j + 1) - y%cc(j - 1)) if (num_dims == 3) then - dx(3) = 0.5_wp*(z_cc(k + 1) - z_cc(k - 1)) + ds(3) = 0.5_wp*(z%cc(k + 1) - z%cc(k - 1)) end if ! compute the velocity gradient tensor do l = 1, num_dims velocity_gradient_tensor(l, 1) = (q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i + 1, j, & - & k) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i - 1, j, k))/(2._wp*dx(1)) + & k) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i - 1, j, k))/(2._wp*ds(1)) velocity_gradient_tensor(l, 2) = (q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j + 1, & - & k) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j - 1, k))/(2._wp*dx(2)) + & k) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j - 1, k))/(2._wp*ds(2)) if (num_dims == 3) then velocity_gradient_tensor(l, 3) = (q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j, & - & k + 1) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j, k - 1))/(2._wp*dx(3)) + & k + 1) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j, k - 1))/(2._wp*ds(3)) end if end do diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 0e6f83ae2f..b51d376458 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -185,17 +185,17 @@ contains type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction integer :: i !< Generic loop iterator real(wp) :: w(1:8) !< Intermediate var for ideal weights: s_cb across overall stencil - real(wp) :: y(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil + real(wp) :: ys(1:4) !< Intermediate var for poly & beta: diff(s_cb) across sub-stencil real(wp) :: h0 !< Reference spacing for uniform-grid detection ! Determine cell count, boundary locations, and BCs for selected WENO direction if (weno_dir == 1) then - s = m; s_cb => x_cb; bc_s = bc_x + s = m; s_cb => x%cb; bc_s = bc_x else if (weno_dir == 2) then - s = n; s_cb => y_cb; bc_s = bc_y + s = n; s_cb => y%cb; bc_s = bc_y else - s = p; s_cb => z_cb; bc_s = bc_z + s = p; s_cb => z%cb; bc_s = bc_z end if #:for WENO_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] @@ -375,7 +375,7 @@ contains ! Smoothness Indicators (beta_coef) To reduce computational cost, we leverage the fact that all ! polynomial coefficients in a stencil sum to 1 and compute the polynomial coefficients (poly_coef_cb) ! for the cell value differences (dvd) instead of the values themselves. The computation of coefficients - ! is further simplified by using grid spacing (y or w) rather than the grid locations (s_cb) directly. + ! is further simplified by using grid spacing (ys or w) rather than the grid locations (s_cb) directly. ! Ideal weights (d_cb) are obtained by comparing the grid location coefficients of the polynomial ! coefficients. The smoothness indicators (beta_coef) are calculated through numerical differentiation ! and integration of each cross term of the polynomial coefficients, using the cell value differences @@ -419,415 +419,451 @@ contains & *(w(1) - w(8))) ! Note: Left has the reversed order of both points and coefficients compared to the right - y = s_cb(i + 1:i + 4) - s_cb(i:i + 3) + ys = s_cb(i + 1:i + 4) - s_cb(i:i + 3) poly_coef_cbR_${XYZ}$ (i + 1, 0, & - & 0) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) & - & + y(2) + y(3) + y(4))) + & 0) = (ys(1)*ys(2)*(ys(2) + ys(3)))/((ys(3) + ys(4))*(ys(2) + ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 0, & - & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) & - & + 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) & - & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 1) = -(ys(1)*ys(2)*(3*ys(2)**2 + 6*ys(2)*ys(3) + 3*ys(2)*ys(4) + 2*ys(1) & + & *ys(2) + 3*ys(3)**2 + 3*ys(3)*ys(4) + 2*ys(1)*ys(3) + ys(4)**2 + ys(1)*ys(4)) & + & )/((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))*(ys(1) & + & + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 0, & - & 2) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 & - & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) & - & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) + & 2) = (ys(1)*(ys(1)**2 + 3*ys(1)*ys(2) + 2*ys(1)*ys(3) + ys(4)*ys(1) + 3*ys(2) & + & **2 + 4*ys(2)*ys(3) + 2*ys(4)*ys(2) + ys(3)**2 + ys(4)*ys(3)))/((ys(1) & + & + ys(2))*(ys(1) + ys(2) + ys(3))*(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i:i + 3) - s_cb(i - 1:i + 2) + ys = s_cb(i:i + 3) - s_cb(i - 1:i + 2) poly_coef_cbR_${XYZ}$ (i + 1, 1, & - & 0) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) & - & + y(2) + y(3) + y(4))) + & 0) = -(ys(2)*ys(3)*(ys(1) + ys(2)))/((ys(3) + ys(4))*(ys(2) + ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 1, & - & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) & - & + 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) & - & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 1) = (ys(2)*(ys(1) + ys(2))*(ys(2)**2 + 4*ys(2)*ys(3) + 2*ys(2)*ys(4) + ys(1) & + & *ys(2) + 3*ys(3)**2 + 3*ys(3)*ys(4) + 2*ys(1)*ys(3) + ys(4)**2 + ys(1)*ys(4)) & + & )/((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))*(ys(1) & + & + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 1, & - & 2) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) & - & + y(2) + y(3) + y(4))) + & 2) = (ys(2)*ys(3)*(ys(3) + ys(4)))/((ys(1) + ys(2))*(ys(1) + ys(2) + ys(3)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1) + ys = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1) poly_coef_cbR_${XYZ}$ (i + 1, 2, & - & 0) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) & - & + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 0) = (ys(3)*(ys(2) + ys(3))*(ys(1) + ys(2) + ys(3)))/((ys(3) + ys(4))*(ys(2) & + & + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 2, & - & 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 & - & + 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) & - & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 1) = (ys(3)*ys(4)*(ys(1)**2 + 3*ys(1)*ys(2) + 3*ys(1)*ys(3) + ys(4)*ys(1) & + & + 3*ys(2)**2 + 6*ys(2)*ys(3) + 2*ys(4)*ys(2) + 3*ys(3)**2 + 2*ys(4)*ys(3))) & + & /((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))*(ys(1) & + & + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 2, & - & 2) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) & - & + y(2) + y(3) + y(4))) + & 2) = -(ys(3)*ys(4)*(ys(2) + ys(3)))/((ys(1) + ys(2))*(ys(1) + ys(2) + ys(3)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i - 2:i + 1) - s_cb(i - 3:i) + ys = s_cb(i - 2:i + 1) - s_cb(i - 3:i) poly_coef_cbR_${XYZ}$ (i + 1, 3, & - & 0) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 & - & + 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) & - & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 0) = (ys(4)*(ys(2)**2 + 4*ys(2)*ys(3) + 4*ys(2)*ys(4) + ys(1)*ys(2) + 3*ys(3) & + & **2 + 6*ys(3)*ys(4) + 2*ys(1)*ys(3) + 3*ys(4)**2 + 2*ys(1)*ys(4)))/((ys(3) & + & + ys(4))*(ys(2) + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 3, & - & 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) & - & + 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)) & - & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) & - & + y(4))) + & 1) = -(ys(4)*(ys(3) + ys(4))*(ys(1)**2 + 3*ys(1)*ys(2) + 3*ys(1)*ys(3) & + & + 2*ys(1)*ys(4) + 3*ys(2)**2 + 6*ys(2)*ys(3) + 4*ys(2)*ys(4) + 3*ys(3)**2 & + & + 4*ys(3)*ys(4) + ys(4)**2))/((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) & + & + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbR_${XYZ}$ (i + 1, 3, & - & 2) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) & - & + y(3))*(y(1) + y(2) + y(3) + y(4))) + & 2) = (ys(4)*(ys(3) + ys(4))*(ys(2) + ys(3) + ys(4)))/((ys(1) + ys(2))*(ys(1) & + & + ys(2) + ys(3))*(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1) + ys = s_cb(i + 1:i - 2:-1) - s_cb(i:i - 3:-1) poly_coef_cbL_${XYZ}$ (i + 1, 3, & - & 2) = (y(1)*y(2)*(y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) & - & + y(2) + y(3) + y(4))) + & 2) = (ys(1)*ys(2)*(ys(2) + ys(3)))/((ys(3) + ys(4))*(ys(2) + ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 3, & - & 1) = -(y(1)*y(2)*(3*y(2)**2 + 6*y(2)*y(3) + 3*y(2)*y(4) + 2*y(1)*y(2) & - & + 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) & - & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 1) = -(ys(1)*ys(2)*(3*ys(2)**2 + 6*ys(2)*ys(3) + 3*ys(2)*ys(4) + 2*ys(1) & + & *ys(2) + 3*ys(3)**2 + 3*ys(3)*ys(4) + 2*ys(1)*ys(3) + ys(4)**2 + ys(1)*ys(4)) & + & )/((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))*(ys(1) & + & + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 3, & - & 0) = (y(1)*(y(1)**2 + 3*y(1)*y(2) + 2*y(1)*y(3) + y(4)*y(1) + 3*y(2)**2 & - & + 4*y(2)*y(3) + 2*y(4)*y(2) + y(3)**2 + y(4)*y(3)))/((y(1) + y(2))*(y(1) & - & + y(2) + y(3))*(y(1) + y(2) + y(3) + y(4))) + & 0) = (ys(1)*(ys(1)**2 + 3*ys(1)*ys(2) + 2*ys(1)*ys(3) + ys(4)*ys(1) + 3*ys(2) & + & **2 + 4*ys(2)*ys(3) + 2*ys(4)*ys(2) + ys(3)**2 + ys(4)*ys(3)))/((ys(1) & + & + ys(2))*(ys(1) + ys(2) + ys(3))*(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1) + ys = s_cb(i + 2:i - 1:-1) - s_cb(i + 1:i - 2:-1) poly_coef_cbL_${XYZ}$ (i + 1, 2, & - & 2) = -(y(2)*y(3)*(y(1) + y(2)))/((y(3) + y(4))*(y(2) + y(3) + y(4))*(y(1) & - & + y(2) + y(3) + y(4))) + & 2) = -(ys(2)*ys(3)*(ys(1) + ys(2)))/((ys(3) + ys(4))*(ys(2) + ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 2, & - & 1) = (y(2)*(y(1) + y(2))*(y(2)**2 + 4*y(2)*y(3) + 2*y(2)*y(4) + y(1)*y(2) & - & + 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) & - & )*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 1) = (ys(2)*(ys(1) + ys(2))*(ys(2)**2 + 4*ys(2)*ys(3) + 2*ys(2)*ys(4) + ys(1) & + & *ys(2) + 3*ys(3)**2 + 3*ys(3)*ys(4) + 2*ys(1)*ys(3) + ys(4)**2 + ys(1)*ys(4)) & + & )/((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))*(ys(1) & + & + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 2, & - & 0) = (y(2)*y(3)*(y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) & - & + y(2) + y(3) + y(4))) + & 0) = (ys(2)*ys(3)*(ys(3) + ys(4)))/((ys(1) + ys(2))*(ys(1) + ys(2) + ys(3)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1) + ys = s_cb(i + 3:i:-1) - s_cb(i + 2:i - 1:-1) poly_coef_cbL_${XYZ}$ (i + 1, 1, & - & 2) = (y(3)*(y(2) + y(3))*(y(1) + y(2) + y(3)))/((y(3) + y(4))*(y(2) + y(3) & - & + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 2) = (ys(3)*(ys(2) + ys(3))*(ys(1) + ys(2) + ys(3)))/((ys(3) + ys(4))*(ys(2) & + & + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 1, & - & 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 & - & + 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) & - & + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 1) = (ys(3)*ys(4)*(ys(1)**2 + 3*ys(1)*ys(2) + 3*ys(1)*ys(3) + ys(4)*ys(1) & + & + 3*ys(2)**2 + 6*ys(2)*ys(3) + 2*ys(4)*ys(2) + 3*ys(3)**2 + 2*ys(4)*ys(3))) & + & /((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))*(ys(1) & + & + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 1, & - & 0) = -(y(3)*y(4)*(y(2) + y(3)))/((y(1) + y(2))*(y(1) + y(2) + y(3))*(y(1) & - & + y(2) + y(3) + y(4))) + & 0) = -(ys(3)*ys(4)*(ys(2) + ys(3)))/((ys(1) + ys(2))*(ys(1) + ys(2) + ys(3)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))) - y = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1) + ys = s_cb(i + 4:i + 1:-1) - s_cb(i + 3:i:-1) poly_coef_cbL_${XYZ}$ (i + 1, 0, & - & 2) = (y(4)*(y(2)**2 + 4*y(2)*y(3) + 4*y(2)*y(4) + y(1)*y(2) + 3*y(3)**2 & - & + 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) & - & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))) + & 2) = (ys(4)*(ys(2)**2 + 4*ys(2)*ys(3) + 4*ys(2)*ys(4) + ys(1)*ys(2) + 3*ys(3) & + & **2 + 6*ys(3)*ys(4) + 2*ys(1)*ys(3) + 3*ys(4)**2 + 2*ys(1)*ys(4)))/((ys(3) & + & + ys(4))*(ys(2) + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 0, & - & 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) & - & + 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)) & - & /((y(2) + y(3))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) & - & + y(4))) + & 1) = -(ys(4)*(ys(3) + ys(4))*(ys(1)**2 + 3*ys(1)*ys(2) + 3*ys(1)*ys(3) & + & + 2*ys(1)*ys(4) + 3*ys(2)**2 + 6*ys(2)*ys(3) + 4*ys(2)*ys(4) + 3*ys(3)**2 & + & + 4*ys(3)*ys(4) + ys(4)**2))/((ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))*(ys(2) & + & + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1, 0, & - & 0) = (y(4)*(y(3) + y(4))*(y(2) + y(3) + y(4)))/((y(1) + y(2))*(y(1) + y(2) & - & + y(3))*(y(1) + y(2) + y(3) + y(4))) + & 0) = (ys(4)*(ys(3) + ys(4))*(ys(2) + ys(3) + ys(4)))/((ys(1) + ys(2))*(ys(1) & + & + ys(2) + ys(3))*(ys(1) + ys(2) + ys(3) + ys(4))) poly_coef_cbL_${XYZ}$ (i + 1,:,:) = -poly_coef_cbL_${XYZ}$ (i + 1,:,:) ! Note: negative sign as the direction of taking the difference (dvd) is reversed - y = s_cb(i - 2:i + 1) - s_cb(i - 3:i) + ys = s_cb(i - 2:i + 1) - s_cb(i - 3:i) beta_coef_${XYZ}$ (i + 1, 3, & - & 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) & - & + 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) & - & **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 & - & + 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) & - & *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) & - & **3*y(3) + 30*y(2)**3*y(4) + 110*y(2)**2*y(3)**2 + 165*y(2)**2*y(3)*y(4) & - & + 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) & - & *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) & - & **2 + 675*y(3)*y(4)**3 + 996*y(4)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4)) & - & **2*(y(1) + y(2) + y(3) + y(4))**2) + & 0) = (4*ys(4)**2*(5*ys(1)**2*ys(2)**2 + 20*ys(1)**2*ys(2)*ys(3) + 15*ys(1) & + & **2*ys(2)*ys(4) + 20*ys(1)**2*ys(3)**2 + 30*ys(1)**2*ys(3)*ys(4) + 60*ys(1) & + & **2*ys(4)**2 + 10*ys(1)*ys(2)**3 + 60*ys(1)*ys(2)**2*ys(3) + 45*ys(1)*ys(2) & + & **2*ys(4) + 110*ys(1)*ys(2)*ys(3)**2 + 165*ys(1)*ys(2)*ys(3)*ys(4) + 260*ys(1) & + & *ys(2)*ys(4)**2 + 60*ys(1)*ys(3)**3 + 135*ys(1)*ys(3)**2*ys(4) + 400*ys(1)*ys(3) & + & *ys(4)**2 + 225*ys(1)*ys(4)**3 + 5*ys(2)**4 + 40*ys(2)**3*ys(3) + 30*ys(2) & + & **3*ys(4) + 110*ys(2)**2*ys(3)**2 + 165*ys(2)**2*ys(3)*ys(4) + 260*ys(2)**2*ys(4) & + & **2 + 120*ys(2)*ys(3)**3 + 270*ys(2)*ys(3)**2*ys(4) + 800*ys(2)*ys(3)*ys(4)**2 & + & + 450*ys(2)*ys(4)**3 + 45*ys(3)**4 + 135*ys(3)**3*ys(4) + 600*ys(3)**2*ys(4)**2 & + & + 675*ys(3)*ys(4)**3 + 996*ys(4)**4))/(5*(ys(3) + ys(4))**2*(ys(2) + ys(3) & + & + ys(4))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 3, & - & 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) & - & **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) & - & + 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) & - & + 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) & - & + 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) & - & *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) & - & *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) & - & *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) & - & **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) & - & **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) & - & *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) & - & + 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) & - & *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) & - & *y(4)**4 + 90*y(3)**5 + 270*y(3)**4*y(4) + 1800*y(3)**3*y(4)**2 + 2655*y(3) & - & **2*y(4)**3 + 4464*y(3)*y(4)**4 + 1767*y(4)**5))/(5*(y(2) + y(3))*(y(3) + y(4)) & - & *(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) + & 1) = -(4*ys(4)**2*(10*ys(1)**3*ys(2)*ys(3) + 5*ys(1)**3*ys(2)*ys(4) + 20*ys(1) & + & **3*ys(3)**2 + 25*ys(1)**3*ys(3)*ys(4) + 105*ys(1)**3*ys(4)**2 + 40*ys(1) & + & **2*ys(2)**2*ys(3) + 20*ys(1)**2*ys(2)**2*ys(4) + 130*ys(1)**2*ys(2)*ys(3)**2 & + & + 155*ys(1)**2*ys(2)*ys(3)*ys(4) + 535*ys(1)**2*ys(2)*ys(4)**2 + 90*ys(1) & + & **2*ys(3)**3 + 165*ys(1)**2*ys(3)**2*ys(4) + 790*ys(1)**2*ys(3)*ys(4)**2 & + & + 415*ys(1)**2*ys(4)**3 + 60*ys(1)*ys(2)**3*ys(3) + 30*ys(1)*ys(2)**3*ys(4) & + & + 270*ys(1)*ys(2)**2*ys(3)**2 + 315*ys(1)*ys(2)**2*ys(3)*ys(4) + 975*ys(1)*ys(2) & + & **2*ys(4)**2 + 360*ys(1)*ys(2)*ys(3)**3 + 645*ys(1)*ys(2)*ys(3)**2*ys(4) & + & + 2850*ys(1)*ys(2)*ys(3)*ys(4)**2 + 1460*ys(1)*ys(2)*ys(4)**3 + 150*ys(1)*ys(3) & + & **4 + 360*ys(1)*ys(3)**3*ys(4) + 2000*ys(1)*ys(3)**2*ys(4)**2 + 2005*ys(1)*ys(3) & + & *ys(4)**3 + 2077*ys(1)*ys(4)**4 + 30*ys(2)**4*ys(3) + 15*ys(2)**4*ys(4) & + & + 180*ys(2)**3*ys(3)**2 + 210*ys(2)**3*ys(3)*ys(4) + 650*ys(2)**3*ys(4)**2 & + & + 360*ys(2)**2*ys(3)**3 + 645*ys(2)**2*ys(3)**2*ys(4) + 2850*ys(2)**2*ys(3)*ys(4) & + & **2 + 1460*ys(2)**2*ys(4)**3 + 300*ys(2)*ys(3)**4 + 720*ys(2)*ys(3)**3*ys(4) & + & + 4000*ys(2)*ys(3)**2*ys(4)**2 + 4010*ys(2)*ys(3)*ys(4)**3 + 4154*ys(2)*ys(4)**4 & + & + 90*ys(3)**5 + 270*ys(3)**4*ys(4) + 1800*ys(3)**3*ys(4)**2 + 2655*ys(3)**2*ys(4) & + & **3 + 4464*ys(3)*ys(4)**4 + 1767*ys(4)**5))/(5*(ys(2) + ys(3))*(ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))**2*(ys(1) + ys(2) + ys(3) & + & + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 3, & - & 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) & - & **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) & - & + 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) & - & *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 & - & + 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) & - & *y(3)**2*y(4) + 725*y(3)*y(4)**3 + 220*y(1)*y(3)*y(4)**2 + 1767*y(4)**4 & - & + 105*y(1)*y(4)**3))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) & - & + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) + & 2) = (4*ys(4)**2*(10*ys(2)**3*ys(3) + 5*ys(2)**3*ys(4) + 50*ys(2)**2*ys(3)**2 & + & + 60*ys(2)**2*ys(3)*ys(4) + 10*ys(1)*ys(2)**2*ys(3) + 215*ys(2)**2*ys(4)**2 & + & + 5*ys(1)*ys(2)**2*ys(4) + 70*ys(2)*ys(3)**3 + 130*ys(2)*ys(3)**2*ys(4) & + & + 30*ys(1)*ys(2)*ys(3)**2 + 775*ys(2)*ys(3)*ys(4)**2 + 35*ys(1)*ys(2)*ys(3)*ys(4) & + & + 415*ys(2)*ys(4)**3 + 110*ys(1)*ys(2)*ys(4)**2 + 30*ys(3)**4 + 75*ys(3)**3*ys(4) & + & + 20*ys(1)*ys(3)**3 + 665*ys(3)**2*ys(4)**2 + 35*ys(1)*ys(3)**2*ys(4) + 725*ys(3) & + & *ys(4)**3 + 220*ys(1)*ys(3)*ys(4)**2 + 1767*ys(4)**4 + 105*ys(1)*ys(4)**3)) & + & /(5*(ys(1) + ys(2))*(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) & + & + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 3, & - & 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 & - & + 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 & - & + 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 & - & + 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) & - & + 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) & - & **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) & - & **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) & - & **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) & - & **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) & - & *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) & - & **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) & - & **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) & - & **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) & - & **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) & - & **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) & - & **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) & - & **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) & - & *y(4)**3 + 4224*y(2)**2*y(4)**4 + 180*y(2)*y(3)**5 + 450*y(2)*y(3)**4*y(4) & - & + 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 & - & + 3524*y(2)*y(4)**5 + 45*y(3)**6 + 135*y(3)**5*y(4) + 1395*y(3)**4*y(4)**2 & - & + 2565*y(3)**3*y(4)**3 + 4884*y(3)**2*y(4)**4 + 3624*y(3)*y(4)**5 + 831*y(4)**6)) & - & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) & - & + y(3) + y(4))**2) + & 3) = (4*ys(4)**2*(5*ys(1)**4*ys(3)**2 + 5*ys(1)**4*ys(3)*ys(4) + 50*ys(1) & + & **4*ys(4)**2 + 30*ys(1)**3*ys(2)*ys(3)**2 + 30*ys(1)**3*ys(2)*ys(3)*ys(4) & + & + 300*ys(1)**3*ys(2)*ys(4)**2 + 30*ys(1)**3*ys(3)**3 + 45*ys(1)**3*ys(3)**2*ys(4) & + & + 415*ys(1)**3*ys(3)*ys(4)**2 + 200*ys(1)**3*ys(4)**3 + 75*ys(1)**2*ys(2) & + & **2*ys(3)**2 + 75*ys(1)**2*ys(2)**2*ys(3)*ys(4) + 750*ys(1)**2*ys(2)**2*ys(4)**2 & + & + 150*ys(1)**2*ys(2)*ys(3)**3 + 225*ys(1)**2*ys(2)*ys(3)**2*ys(4) + 2075*ys(1) & + & **2*ys(2)*ys(3)*ys(4)**2 + 1000*ys(1)**2*ys(2)*ys(4)**3 + 75*ys(1)**2*ys(3)**4 & + & + 150*ys(1)**2*ys(3)**3*ys(4) + 1390*ys(1)**2*ys(3)**2*ys(4)**2 + 1315*ys(1) & + & **2*ys(3)*ys(4)**3 + 1081*ys(1)**2*ys(4)**4 + 90*ys(1)*ys(2)**3*ys(3)**2 & + & + 90*ys(1)*ys(2)**3*ys(3)*ys(4) + 900*ys(1)*ys(2)**3*ys(4)**2 + 270*ys(1)*ys(2) & + & **2*ys(3)**3 + 405*ys(1)*ys(2)**2*ys(3)**2*ys(4) + 3735*ys(1)*ys(2)**2*ys(3) & + & *ys(4)**2 + 1800*ys(1)*ys(2)**2*ys(4)**3 + 270*ys(1)*ys(2)*ys(3)**4 + 540*ys(1) & + & *ys(2)*ys(3)**3*ys(4) + 5025*ys(1)*ys(2)*ys(3)**2*ys(4)**2 + 4755*ys(1)*ys(2) & + & *ys(3)*ys(4)**3 + 4224*ys(1)*ys(2)*ys(4)**4 + 90*ys(1)*ys(3)**5 + 225*ys(1)*ys(3) & + & **4*ys(4) + 2190*ys(1)*ys(3)**3*ys(4)**2 + 3060*ys(1)*ys(3)**2*ys(4)**3 & + & + 4529*ys(1)*ys(3)*ys(4)**4 + 1762*ys(1)*ys(4)**5 + 45*ys(2)**4*ys(3)**2 & + & + 45*ys(2)**4*ys(3)*ys(4) + 450*ys(2)**4*ys(4)**2 + 180*ys(2)**3*ys(3)**3 & + & + 270*ys(2)**3*ys(3)**2*ys(4) + 2490*ys(2)**3*ys(3)*ys(4)**2 + 1200*ys(2) & + & **3*ys(4)**3 + 270*ys(2)**2*ys(3)**4 + 540*ys(2)**2*ys(3)**3*ys(4) + 5025*ys(2) & + & **2*ys(3)**2*ys(4)**2 + 4755*ys(2)**2*ys(3)*ys(4)**3 + 4224*ys(2)**2*ys(4)**4 & + & + 180*ys(2)*ys(3)**5 + 450*ys(2)*ys(3)**4*ys(4) + 4380*ys(2)*ys(3)**3*ys(4)**2 & + & + 6120*ys(2)*ys(3)**2*ys(4)**3 + 9058*ys(2)*ys(3)*ys(4)**4 + 3524*ys(2)*ys(4)**5 & + & + 45*ys(3)**6 + 135*ys(3)**5*ys(4) + 1395*ys(3)**4*ys(4)**2 + 2565*ys(3)**3*ys(4) & + & **3 + 4884*ys(3)**2*ys(4)**4 + 3624*ys(3)*ys(4)**5 + 831*ys(4)**6))/(5*(ys(2) & + & + ys(3))**2*(ys(1) + ys(2) + ys(3))**2*(ys(2) + ys(3) + ys(4))**2*(ys(1) + ys(2) & + & + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 3, & - & 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) & - & **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) & - & **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) & - & **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) & - & *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) & - & *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) & - & **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) & - & **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) & - & *y(4)**2 + 700*y(2)**2*y(4)**3 + 90*y(2)*y(3)**4 + 180*y(2)*y(3)**3*y(4) & - & + 2205*y(2)*y(3)**2*y(4)**2 + 2115*y(2)*y(3)*y(4)**3 + 3624*y(2)*y(4)**4 & - & + 30*y(3)**5 + 75*y(3)**4*y(4) + 1060*y(3)**3*y(4)**2 + 1515*y(3)**2*y(4)**3 & - & + 3824*y(3)*y(4)**4 + 1662*y(4)**5))/(5*(y(1) + y(2))*(y(2) + y(3))*(y(1) + y(2) & - & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) + & 4) = -(4*ys(4)**2*(10*ys(1)**2*ys(2)*ys(3)**2 + 10*ys(1)**2*ys(2)*ys(3)*ys(4) & + & + 100*ys(1)**2*ys(2)*ys(4)**2 + 10*ys(1)**2*ys(3)**3 + 15*ys(1)**2*ys(3)**2*ys(4) & + & + 205*ys(1)**2*ys(3)*ys(4)**2 + 100*ys(1)**2*ys(4)**3 + 30*ys(1)*ys(2)**2*ys(3) & + & **2 + 30*ys(1)*ys(2)**2*ys(3)*ys(4) + 300*ys(1)*ys(2)**2*ys(4)**2 + 60*ys(1) & + & *ys(2)*ys(3)**3 + 90*ys(1)*ys(2)*ys(3)**2*ys(4) + 1030*ys(1)*ys(2)*ys(3)*ys(4) & + & **2 + 500*ys(1)*ys(2)*ys(4)**3 + 30*ys(1)*ys(3)**4 + 60*ys(1)*ys(3)**3*ys(4) & + & + 835*ys(1)*ys(3)**2*ys(4)**2 + 805*ys(1)*ys(3)*ys(4)**3 + 1762*ys(1)*ys(4)**4 & + & + 30*ys(2)**3*ys(3)**2 + 30*ys(2)**3*ys(3)*ys(4) + 300*ys(2)**3*ys(4)**2 & + & + 90*ys(2)**2*ys(3)**3 + 135*ys(2)**2*ys(3)**2*ys(4) + 1445*ys(2)**2*ys(3)*ys(4) & + & **2 + 700*ys(2)**2*ys(4)**3 + 90*ys(2)*ys(3)**4 + 180*ys(2)*ys(3)**3*ys(4) & + & + 2205*ys(2)*ys(3)**2*ys(4)**2 + 2115*ys(2)*ys(3)*ys(4)**3 + 3624*ys(2)*ys(4)**4 & + & + 30*ys(3)**5 + 75*ys(3)**4*ys(4) + 1060*ys(3)**3*ys(4)**2 + 1515*ys(3)**2*ys(4) & + & **3 + 3824*ys(3)*ys(4)**4 + 1662*ys(4)**5))/(5*(ys(1) + ys(2))*(ys(2) + ys(3)) & + & *(ys(1) + ys(2) + ys(3))**2*(ys(2) + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) & + & + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 3, & - & 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 & - & + 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) & - & **3 + 5*y(3)**4 + 10*y(3)**3*y(4) + 205*y(3)**2*y(4)**2 + 200*y(3)*y(4)**3 & - & + 831*y(4)**4))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) & - & + y(4))**2) + & 5) = (4*ys(4)**2*(5*ys(2)**2*ys(3)**2 + 5*ys(2)**2*ys(3)*ys(4) + 50*ys(2) & + & **2*ys(4)**2 + 10*ys(2)*ys(3)**3 + 15*ys(2)*ys(3)**2*ys(4) + 205*ys(2)*ys(3) & + & *ys(4)**2 + 100*ys(2)*ys(4)**3 + 5*ys(3)**4 + 10*ys(3)**3*ys(4) + 205*ys(3) & + & **2*ys(4)**2 + 200*ys(3)*ys(4)**3 + 831*ys(4)**4))/(5*(ys(1) + ys(2))**2*(ys(1) & + & + ys(2) + ys(3))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) - y = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1) + ys = s_cb(i - 1:i + 2) - s_cb(i - 2:i + 1) beta_coef_${XYZ}$ (i + 1, 2, & - & 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 & - & + 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) & - & **3 + 5*y(2)**4 + 10*y(2)**3*y(3) + 205*y(2)**2*y(3)**2 + 200*y(2)*y(3)**3 & - & + 831*y(3)**4))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) & - & + y(4))**2) + & 0) = (4*ys(3)**2*(5*ys(1)**2*ys(2)**2 + 5*ys(1)**2*ys(2)*ys(3) + 50*ys(1) & + & **2*ys(3)**2 + 10*ys(1)*ys(2)**3 + 15*ys(1)*ys(2)**2*ys(3) + 205*ys(1)*ys(2) & + & *ys(3)**2 + 100*ys(1)*ys(3)**3 + 5*ys(2)**4 + 10*ys(2)**3*ys(3) + 205*ys(2) & + & **2*ys(3)**2 + 200*ys(2)*ys(3)**3 + 831*ys(3)**4))/(5*(ys(3) + ys(4))**2*(ys(2) & + & + ys(3) + ys(4))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 2, & - & 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 & - & + 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) & - & - 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 & - & - 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 & - & + 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 & - & + 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 & - & + 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 & - & + 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) & - & **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 & - & - 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 & - & - 3694*y(2)*y(3)**4 + 250*y(2)*y(3)**3*y(4) + 220*y(2)*y(3)**2*y(4)**2 & - & - 3219*y(3)**5 - 1452*y(3)**4*y(4) + 105*y(3)**3*y(4)**2))/(5*(y(2) + y(3))*(y(3) & - & + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4)) & - & **2) + & 1) = (4*ys(3)**2*(5*ys(1)**3*ys(2)*ys(3) + 10*ys(1)**3*ys(2)*ys(4) - 95*ys(1) & + & **3*ys(3)**2 + 5*ys(1)**3*ys(3)*ys(4) + 20*ys(1)**2*ys(2)**2*ys(3) + 40*ys(1) & + & **2*ys(2)**2*ys(4) - 465*ys(1)**2*ys(2)*ys(3)**2 + 55*ys(1)**2*ys(2)*ys(3)*ys(4) & + & + 10*ys(1)**2*ys(2)*ys(4)**2 - 285*ys(1)**2*ys(3)**3 + 20*ys(1)**2*ys(3)**2*ys(4) & + & + 5*ys(1)**2*ys(3)*ys(4)**2 + 30*ys(1)*ys(2)**3*ys(3) + 60*ys(1)*ys(2)**3*ys(4) & + & - 825*ys(1)*ys(2)**2*ys(3)**2 + 135*ys(1)*ys(2)**2*ys(3)*ys(4) + 30*ys(1)*ys(2) & + & **2*ys(4)**2 - 1040*ys(1)*ys(2)*ys(3)**3 + 100*ys(1)*ys(2)*ys(3)**2*ys(4) & + & + 35*ys(1)*ys(2)*ys(3)*ys(4)**2 - 1847*ys(1)*ys(3)**4 + 125*ys(1)*ys(3)**3*ys(4) & + & + 110*ys(1)*ys(3)**2*ys(4)**2 + 15*ys(2)**4*ys(3) + 30*ys(2)**4*ys(4) - 550*ys(2) & + & **3*ys(3)**2 + 90*ys(2)**3*ys(3)*ys(4) + 20*ys(2)**3*ys(4)**2 - 1040*ys(2) & + & **2*ys(3)**3 + 100*ys(2)**2*ys(3)**2*ys(4) + 35*ys(2)**2*ys(3)*ys(4)**2 & + & - 3694*ys(2)*ys(3)**4 + 250*ys(2)*ys(3)**3*ys(4) + 220*ys(2)*ys(3)**2*ys(4)**2 & + & - 3219*ys(3)**5 - 1452*ys(3)**4*ys(4) + 105*ys(3)**3*ys(4)**2))/(5*(ys(2) + ys(3) & + & )*(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))**2*(ys(1) & + & + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 2, & - & 2) = -(4*y(3)**2*(5*y(2)**3*y(3) - 95*y(2)*y(3)**3 - 190*y(2)**2*y(3)**2 & - & + 10*y(2)**3*y(4) + 100*y(3)**3*y(4) - 1562*y(3)**4 - 95*y(1)*y(2)*y(3)**2 & - & + 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) & - & *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)) & - & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) & - & + y(4))**2) + & 2) = -(4*ys(3)**2*(5*ys(2)**3*ys(3) - 95*ys(2)*ys(3)**3 - 190*ys(2)**2*ys(3)**2 & + & + 10*ys(2)**3*ys(4) + 100*ys(3)**3*ys(4) - 1562*ys(3)**4 - 95*ys(1)*ys(2)*ys(3) & + & **2 + 5*ys(1)*ys(2)**2*ys(3) + 10*ys(1)*ys(2)**2*ys(4) + 100*ys(1)*ys(3)**2*ys(4) & + & + 205*ys(2)*ys(3)**2*ys(4) + 15*ys(2)**2*ys(3)*ys(4) + 10*ys(1)*ys(2)*ys(3)*ys(4) & + & ))/(5*(ys(1) + ys(2))*(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) & + & + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 2, & - & 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 & - & + 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 & - & + 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 & - & + 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) & - & + 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) & - & **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) & - & **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) & - & **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) & - & **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) & - & *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 & - & + 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) & - & **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 & - & + 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 & - & + 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) & - & **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) & - & *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) & - & + 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 & - & + 6648*y(2)*y(3)**5 + 2814*y(2)*y(3)**4*y(4) - 200*y(2)*y(3)**3*y(4)**2 & - & + 140*y(2)*y(3)**2*y(4)**3 + 30*y(2)*y(3)*y(4)**4 + 3174*y(3)**6 + 3039*y(3) & - & **5*y(4) + 771*y(3)**4*y(4)**2 + 135*y(3)**3*y(4)**3 + 60*y(3)**2*y(4)**4)) & - & /(5*(y(2) + y(3))**2*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) & - & + y(3) + y(4))**2) + & 3) = (4*ys(3)**2*(50*ys(1)**4*ys(3)**2 + 5*ys(1)**4*ys(3)*ys(4) + 5*ys(1) & + & **4*ys(4)**2 + 300*ys(1)**3*ys(2)*ys(3)**2 + 30*ys(1)**3*ys(2)*ys(3)*ys(4) & + & + 30*ys(1)**3*ys(2)*ys(4)**2 + 200*ys(1)**3*ys(3)**3 + 25*ys(1)**3*ys(3)**2*ys(4) & + & + 35*ys(1)**3*ys(3)*ys(4)**2 + 10*ys(1)**3*ys(4)**3 + 750*ys(1)**2*ys(2)**2*ys(3) & + & **2 + 75*ys(1)**2*ys(2)**2*ys(3)*ys(4) + 75*ys(1)**2*ys(2)**2*ys(4)**2 & + & + 1000*ys(1)**2*ys(2)*ys(3)**3 + 125*ys(1)**2*ys(2)*ys(3)**2*ys(4) + 175*ys(1) & + & **2*ys(2)*ys(3)*ys(4)**2 + 50*ys(1)**2*ys(2)*ys(4)**3 + 1081*ys(1)**2*ys(3)**4 & + & - 50*ys(1)**2*ys(3)**3*ys(4) - 10*ys(1)**2*ys(3)**2*ys(4)**2 + 45*ys(1)**2*ys(3) & + & *ys(4)**3 + 5*ys(1)**2*ys(4)**4 + 900*ys(1)*ys(2)**3*ys(3)**2 + 90*ys(1)*ys(2) & + & **3*ys(3)*ys(4) + 90*ys(1)*ys(2)**3*ys(4)**2 + 1800*ys(1)*ys(2)**2*ys(3)**3 & + & + 225*ys(1)*ys(2)**2*ys(3)**2*ys(4) + 315*ys(1)*ys(2)**2*ys(3)*ys(4)**2 & + & + 90*ys(1)*ys(2)**2*ys(4)**3 + 4224*ys(1)*ys(2)*ys(3)**4 - 120*ys(1)*ys(2)*ys(3) & + & **3*ys(4) + 25*ys(1)*ys(2)*ys(3)**2*ys(4)**2 + 165*ys(1)*ys(2)*ys(3)*ys(4)**3 & + & + 20*ys(1)*ys(2)*ys(4)**4 + 3324*ys(1)*ys(3)**5 + 1407*ys(1)*ys(3)**4*ys(4) & + & - 100*ys(1)*ys(3)**3*ys(4)**2 + 70*ys(1)*ys(3)**2*ys(4)**3 + 15*ys(1)*ys(3)*ys(4) & + & **4 + 450*ys(2)**4*ys(3)**2 + 45*ys(2)**4*ys(3)*ys(4) + 45*ys(2)**4*ys(4)**2 & + & + 1200*ys(2)**3*ys(3)**3 + 150*ys(2)**3*ys(3)**2*ys(4) + 210*ys(2)**3*ys(3)*ys(4) & + & **2 + 60*ys(2)**3*ys(4)**3 + 4224*ys(2)**2*ys(3)**4 - 120*ys(2)**2*ys(3)**3*ys(4) & + & + 25*ys(2)**2*ys(3)**2*ys(4)**2 + 165*ys(2)**2*ys(3)*ys(4)**3 + 20*ys(2)**2*ys(4) & + & **4 + 6648*ys(2)*ys(3)**5 + 2814*ys(2)*ys(3)**4*ys(4) - 200*ys(2)*ys(3)**3*ys(4) & + & **2 + 140*ys(2)*ys(3)**2*ys(4)**3 + 30*ys(2)*ys(3)*ys(4)**4 + 3174*ys(3)**6 & + & + 3039*ys(3)**5*ys(4) + 771*ys(3)**4*ys(4)**2 + 135*ys(3)**3*ys(4)**3 + 60*ys(3) & + & **2*ys(4)**4))/(5*(ys(2) + ys(3))**2*(ys(1) + ys(2) + ys(3))**2*(ys(2) + ys(3) & + & + ys(4))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 2, & - & 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) & - & **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) & - & *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) & - & *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) & - & *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) & - & **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) & - & **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) & - & *y(4)**2 + 20*y(2)**2*y(4)**3 + 3224*y(2)*y(3)**4 - 460*y(2)*y(3)**3*y(4) & - & - 35*y(2)*y(3)**2*y(4)**2 + 25*y(2)*y(3)*y(4)**3 + 3124*y(3)**5 + 1467*y(3) & - & **4*y(4) + 110*y(3)**3*y(4)**2 + 105*y(3)**2*y(4)**3))/(5*(y(1) + y(2))*(y(2) & - & + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4)) & - & **2) + & 4) = -(4*ys(3)**2*(100*ys(1)**2*ys(2)*ys(3)**2 + 10*ys(1)**2*ys(2)*ys(3)*ys(4) & + & + 10*ys(1)**2*ys(2)*ys(4)**2 - 95*ys(1)**2*ys(3)**2*ys(4) + 5*ys(1)**2*ys(3) & + & *ys(4)**2 + 300*ys(1)*ys(2)**2*ys(3)**2 + 30*ys(1)*ys(2)**2*ys(3)*ys(4) & + & + 30*ys(1)*ys(2)**2*ys(4)**2 + 200*ys(1)*ys(2)*ys(3)**3 - 260*ys(1)*ys(2)*ys(3) & + & **2*ys(4) + 50*ys(1)*ys(2)*ys(3)*ys(4)**2 + 10*ys(1)*ys(2)*ys(4)**3 + 1562*ys(1) & + & *ys(3)**4 - 190*ys(1)*ys(3)**3*ys(4) + 15*ys(1)*ys(3)**2*ys(4)**2 + 5*ys(1)*ys(3) & + & *ys(4)**3 + 300*ys(2)**3*ys(3)**2 + 30*ys(2)**3*ys(3)*ys(4) + 30*ys(2)**3*ys(4) & + & **2 + 400*ys(2)**2*ys(3)**3 - 235*ys(2)**2*ys(3)**2*ys(4) + 85*ys(2)**2*ys(3) & + & *ys(4)**2 + 20*ys(2)**2*ys(4)**3 + 3224*ys(2)*ys(3)**4 - 460*ys(2)*ys(3)**3*ys(4) & + & - 35*ys(2)*ys(3)**2*ys(4)**2 + 25*ys(2)*ys(3)*ys(4)**3 + 3124*ys(3)**5 & + & + 1467*ys(3)**4*ys(4) + 110*ys(3)**3*ys(4)**2 + 105*ys(3)**2*ys(4)**3))/(5*(ys(1) & + & + ys(2))*(ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))**2*(ys(2) + ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 2, & - & 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 & - & - 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)) & - & /(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) + y(3) + y(4))**2) + & 5) = (4*ys(3)**2*(50*ys(2)**2*ys(3)**2 + 5*ys(2)**2*ys(3)*ys(4) + 5*ys(2) & + & **2*ys(4)**2 - 95*ys(2)*ys(3)**2*ys(4) + 5*ys(2)*ys(3)*ys(4)**2 + 781*ys(3)**4 & + & + 50*ys(3)**2*ys(4)**2))/(5*(ys(1) + ys(2))**2*(ys(1) + ys(2) + ys(3))**2*(ys(1) & + & + ys(2) + ys(3) + ys(4))**2) - y = s_cb(i:i + 3) - s_cb(i - 1:i + 2) + ys = s_cb(i:i + 3) - s_cb(i - 1:i + 2) beta_coef_${XYZ}$ (i + 1, 1, & - & 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 & - & - 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)) & - & /(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) + & 0) = (4*ys(2)**2*(50*ys(1)**2*ys(2)**2 + 5*ys(1)**2*ys(2)*ys(3) + 5*ys(1) & + & **2*ys(3)**2 - 95*ys(1)*ys(2)**2*ys(3) + 5*ys(1)*ys(2)*ys(3)**2 + 781*ys(2)**4 & + & + 50*ys(2)**2*ys(3)**2))/(5*(ys(3) + ys(4))**2*(ys(2) + ys(3) + ys(4))**2*(ys(1) & + & + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 1, & - & 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) & - & *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) & - & **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) & - & **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) & - & **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) & - & **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) & - & **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) & - & *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) & - & + 1562*y(2)**4*y(4) + 400*y(2)**3*y(3)**2 + 200*y(2)**3*y(3)*y(4) + 300*y(2) & - & **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) & - & + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))**2*(y(1) + y(2) & - & + y(3) + y(4))**2) + & 1) = -(4*ys(2)**2*(105*ys(1)**3*ys(2)**2 + 25*ys(1)**3*ys(2)*ys(3) + 5*ys(1) & + & **3*ys(2)*ys(4) + 20*ys(1)**3*ys(3)**2 + 10*ys(1)**3*ys(3)*ys(4) + 110*ys(1) & + & **2*ys(2)**3 - 35*ys(1)**2*ys(2)**2*ys(3) + 15*ys(1)**2*ys(2)**2*ys(4) + 85*ys(1) & + & **2*ys(2)*ys(3)**2 + 50*ys(1)**2*ys(2)*ys(3)*ys(4) + 5*ys(1)**2*ys(2)*ys(4)**2 & + & + 30*ys(1)**2*ys(3)**3 + 30*ys(1)**2*ys(3)**2*ys(4) + 10*ys(1)**2*ys(3)*ys(4)**2 & + & + 1467*ys(1)*ys(2)**4 - 460*ys(1)*ys(2)**3*ys(3) - 190*ys(1)*ys(2)**3*ys(4) & + & - 235*ys(1)*ys(2)**2*ys(3)**2 - 260*ys(1)*ys(2)**2*ys(3)*ys(4) - 95*ys(1)*ys(2) & + & **2*ys(4)**2 + 30*ys(1)*ys(2)*ys(3)**3 + 30*ys(1)*ys(2)*ys(3)**2*ys(4) + 10*ys(1) & + & *ys(2)*ys(3)*ys(4)**2 + 3124*ys(2)**5 + 3224*ys(2)**4*ys(3) + 1562*ys(2)**4*ys(4) & + & + 400*ys(2)**3*ys(3)**2 + 200*ys(2)**3*ys(3)*ys(4) + 300*ys(2)**2*ys(3)**3 & + & + 300*ys(2)**2*ys(3)**2*ys(4) + 100*ys(2)**2*ys(3)*ys(4)**2))/(5*(ys(2) + ys(3)) & + & *(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))**2*(ys(1) & + & + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 1, & - & 2) = -(4*y(2)**2*(100*y(1)*y(2)**3 - 190*y(2)**2*y(3)**2 + 10*y(1)*y(3)**3 & - & + 5*y(2)*y(3)**3 - 95*y(2)**3*y(3) - 1562*y(2)**4 + 15*y(1)*y(2)*y(3)**2 & - & + 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) & - & *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)) & - & *(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) & - & + y(4))**2) + & 2) = -(4*ys(2)**2*(100*ys(1)*ys(2)**3 - 190*ys(2)**2*ys(3)**2 + 10*ys(1)*ys(3) & + & **3 + 5*ys(2)*ys(3)**3 - 95*ys(2)**3*ys(3) - 1562*ys(2)**4 + 15*ys(1)*ys(2)*ys(3) & + & **2 + 205*ys(1)*ys(2)**2*ys(3) + 100*ys(1)*ys(2)**2*ys(4) + 10*ys(1)*ys(3) & + & **2*ys(4) + 5*ys(2)*ys(3)**2*ys(4) - 95*ys(2)**2*ys(3)*ys(4) + 10*ys(1)*ys(2) & + & *ys(3)*ys(4)))/(5*(ys(1) + ys(2))*(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3))*(ys(2) & + & + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 1, & - & 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) & - & + 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) & - & **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) & - & **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) & - & **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) & - & **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) & - & + 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) & - & **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) & - & **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) & - & **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) & - & **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) & - & - 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) & - & **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) & - & **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) & - & *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) & - & *y(2)*y(4)**4 + 3174*y(2)**6 + 6648*y(2)**5*y(3) + 3324*y(2)**5*y(4) + 4224*y(2) & - & **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) & - & **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) & - & **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) & - & **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) & - & + y(2) + y(3))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) + & 3) = (4*ys(2)**2*(60*ys(1)**4*ys(2)**2 + 30*ys(1)**4*ys(2)*ys(3) + 15*ys(1) & + & **4*ys(2)*ys(4) + 20*ys(1)**4*ys(3)**2 + 20*ys(1)**4*ys(3)*ys(4) + 5*ys(1) & + & **4*ys(4)**2 + 135*ys(1)**3*ys(2)**3 + 140*ys(1)**3*ys(2)**2*ys(3) + 70*ys(1) & + & **3*ys(2)**2*ys(4) + 165*ys(1)**3*ys(2)*ys(3)**2 + 165*ys(1)**3*ys(2)*ys(3)*ys(4) & + & + 45*ys(1)**3*ys(2)*ys(4)**2 + 60*ys(1)**3*ys(3)**3 + 90*ys(1)**3*ys(3)**2*ys(4) & + & + 50*ys(1)**3*ys(3)*ys(4)**2 + 10*ys(1)**3*ys(4)**3 + 771*ys(1)**2*ys(2)**4 & + & - 200*ys(1)**2*ys(2)**3*ys(3) - 100*ys(1)**2*ys(2)**3*ys(4) + 25*ys(1)**2*ys(2) & + & **2*ys(3)**2 + 25*ys(1)**2*ys(2)**2*ys(3)*ys(4) - 10*ys(1)**2*ys(2)**2*ys(4)**2 & + & + 210*ys(1)**2*ys(2)*ys(3)**3 + 315*ys(1)**2*ys(2)*ys(3)**2*ys(4) + 175*ys(1) & + & **2*ys(2)*ys(3)*ys(4)**2 + 35*ys(1)**2*ys(2)*ys(4)**3 + 45*ys(1)**2*ys(3)**4 & + & + 90*ys(1)**2*ys(3)**3*ys(4) + 75*ys(1)**2*ys(3)**2*ys(4)**2 + 30*ys(1)**2*ys(3) & + & *ys(4)**3 + 5*ys(1)**2*ys(4)**4 + 3039*ys(1)*ys(2)**5 + 2814*ys(1)*ys(2)**4*ys(3) & + & + 1407*ys(1)*ys(2)**4*ys(4) - 120*ys(1)*ys(2)**3*ys(3)**2 - 120*ys(1)*ys(2) & + & **3*ys(3)*ys(4) - 50*ys(1)*ys(2)**3*ys(4)**2 + 150*ys(1)*ys(2)**2*ys(3)**3 & + & + 225*ys(1)*ys(2)**2*ys(3)**2*ys(4) + 125*ys(1)*ys(2)**2*ys(3)*ys(4)**2 & + & + 25*ys(1)*ys(2)**2*ys(4)**3 + 45*ys(1)*ys(2)*ys(3)**4 + 90*ys(1)*ys(2)*ys(3) & + & **3*ys(4) + 75*ys(1)*ys(2)*ys(3)**2*ys(4)**2 + 30*ys(1)*ys(2)*ys(3)*ys(4)**3 & + & + 5*ys(1)*ys(2)*ys(4)**4 + 3174*ys(2)**6 + 6648*ys(2)**5*ys(3) + 3324*ys(2) & + & **5*ys(4) + 4224*ys(2)**4*ys(3)**2 + 4224*ys(2)**4*ys(3)*ys(4) + 1081*ys(2) & + & **4*ys(4)**2 + 1200*ys(2)**3*ys(3)**3 + 1800*ys(2)**3*ys(3)**2*ys(4) + 1000*ys(2) & + & **3*ys(3)*ys(4)**2 + 200*ys(2)**3*ys(4)**3 + 450*ys(2)**2*ys(3)**4 + 900*ys(2) & + & **2*ys(3)**3*ys(4) + 750*ys(2)**2*ys(3)**2*ys(4)**2 + 300*ys(2)**2*ys(3)*ys(4) & + & **3 + 50*ys(2)**2*ys(4)**4))/(5*(ys(2) + ys(3))**2*(ys(1) + ys(2) + ys(3)) & + & **2*(ys(2) + ys(3) + ys(4))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 1, & - & 4) = (4*y(2)**2*(105*y(1)**2*y(2)**3 + 220*y(1)**2*y(2)**2*y(3) + 110*y(1) & - & **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) & - & **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) & - & *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) & - & + 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) & - & **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) & - & **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) & - & **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) & - & **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 & - & - 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 & - & - 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) & - & **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) & - & + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) + y(4))**2) + & 4) = (4*ys(2)**2*(105*ys(1)**2*ys(2)**3 + 220*ys(1)**2*ys(2)**2*ys(3) + 110*ys(1) & + & **2*ys(2)**2*ys(4) + 35*ys(1)**2*ys(2)*ys(3)**2 + 35*ys(1)**2*ys(2)*ys(3)*ys(4) & + & + 5*ys(1)**2*ys(2)*ys(4)**2 + 20*ys(1)**2*ys(3)**3 + 30*ys(1)**2*ys(3)**2*ys(4) & + & + 10*ys(1)**2*ys(3)*ys(4)**2 - 1452*ys(1)*ys(2)**4 + 250*ys(1)*ys(2)**3*ys(3) & + & + 125*ys(1)*ys(2)**3*ys(4) + 100*ys(1)*ys(2)**2*ys(3)**2 + 100*ys(1)*ys(2) & + & **2*ys(3)*ys(4) + 20*ys(1)*ys(2)**2*ys(4)**2 + 90*ys(1)*ys(2)*ys(3)**3 & + & + 135*ys(1)*ys(2)*ys(3)**2*ys(4) + 55*ys(1)*ys(2)*ys(3)*ys(4)**2 + 5*ys(1)*ys(2) & + & *ys(4)**3 + 30*ys(1)*ys(3)**4 + 60*ys(1)*ys(3)**3*ys(4) + 40*ys(1)*ys(3)**2*ys(4) & + & **2 + 10*ys(1)*ys(3)*ys(4)**3 - 3219*ys(2)**5 - 3694*ys(2)**4*ys(3) - 1847*ys(2) & + & **4*ys(4) - 1040*ys(2)**3*ys(3)**2 - 1040*ys(2)**3*ys(3)*ys(4) - 285*ys(2) & + & **3*ys(4)**2 - 550*ys(2)**2*ys(3)**3 - 825*ys(2)**2*ys(3)**2*ys(4) - 465*ys(2) & + & **2*ys(3)*ys(4)**2 - 95*ys(2)**2*ys(4)**3 + 15*ys(2)*ys(3)**4 + 30*ys(2)*ys(3) & + & **3*ys(4) + 20*ys(2)*ys(3)**2*ys(4)**2 + 5*ys(2)*ys(3)*ys(4)**3))/(5*(ys(1) & + & + ys(2))*(ys(2) + ys(3))*(ys(1) + ys(2) + ys(3))**2*(ys(2) + ys(3) + ys(4)) & + & *(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 1, & - & 5) = (4*y(2)**2*(831*y(2)**4 + 200*y(2)**3*y(3) + 100*y(2)**3*y(4) + 205*y(2) & - & **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 & - & + 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) & - & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) & - & + y(3) + y(4))**2) + & 5) = (4*ys(2)**2*(831*ys(2)**4 + 200*ys(2)**3*ys(3) + 100*ys(2)**3*ys(4) & + & + 205*ys(2)**2*ys(3)**2 + 205*ys(2)**2*ys(3)*ys(4) + 50*ys(2)**2*ys(4)**2 & + & + 10*ys(2)*ys(3)**3 + 15*ys(2)*ys(3)**2*ys(4) + 5*ys(2)*ys(3)*ys(4)**2 + 5*ys(3) & + & **4 + 10*ys(3)**3*ys(4) + 5*ys(3)**2*ys(4)**2))/(5*(ys(1) + ys(2))**2*(ys(1) & + & + ys(2) + ys(3))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) - y = s_cb(i + 1:i + 4) - s_cb(i:i + 3) + ys = s_cb(i + 1:i + 4) - s_cb(i:i + 3) beta_coef_${XYZ}$ (i + 1, 0, & - & 0) = (4*y(1)**2*(831*y(1)**4 + 200*y(1)**3*y(2) + 100*y(1)**3*y(3) + 205*y(1) & - & **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 & - & + 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) & - & + 5*y(2)**2*y(3)**2))/(5*(y(3) + y(4))**2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) & - & + y(3) + y(4))**2) + & 0) = (4*ys(1)**2*(831*ys(1)**4 + 200*ys(1)**3*ys(2) + 100*ys(1)**3*ys(3) & + & + 205*ys(1)**2*ys(2)**2 + 205*ys(1)**2*ys(2)*ys(3) + 50*ys(1)**2*ys(3)**2 & + & + 10*ys(1)*ys(2)**3 + 15*ys(1)*ys(2)**2*ys(3) + 5*ys(1)*ys(2)*ys(3)**2 + 5*ys(2) & + & **4 + 10*ys(2)**3*ys(3) + 5*ys(2)**2*ys(3)**2))/(5*(ys(3) + ys(4))**2*(ys(2) & + & + ys(3) + ys(4))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 0, & - & 1) = -(4*y(1)**2*(1662*y(1)**5 + 3824*y(1)**4*y(2) + 3624*y(1)**4*y(3) & - & + 1762*y(1)**4*y(4) + 1515*y(1)**3*y(2)**2 + 2115*y(1)**3*y(2)*y(3) + 805*y(1) & - & **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) & - & **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) & - & + 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) & - & **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 & - & + 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) & - & **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) & - & *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 & - & + 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) & - & + 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) & - & **2*y(3)*y(4)**2))/(5*(y(2) + y(3))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) & - & + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) + & 1) = -(4*ys(1)**2*(1662*ys(1)**5 + 3824*ys(1)**4*ys(2) + 3624*ys(1)**4*ys(3) & + & + 1762*ys(1)**4*ys(4) + 1515*ys(1)**3*ys(2)**2 + 2115*ys(1)**3*ys(2)*ys(3) & + & + 805*ys(1)**3*ys(2)*ys(4) + 700*ys(1)**3*ys(3)**2 + 500*ys(1)**3*ys(3)*ys(4) & + & + 100*ys(1)**3*ys(4)**2 + 1060*ys(1)**2*ys(2)**3 + 2205*ys(1)**2*ys(2)**2*ys(3) & + & + 835*ys(1)**2*ys(2)**2*ys(4) + 1445*ys(1)**2*ys(2)*ys(3)**2 + 1030*ys(1) & + & **2*ys(2)*ys(3)*ys(4) + 205*ys(1)**2*ys(2)*ys(4)**2 + 300*ys(1)**2*ys(3)**3 & + & + 300*ys(1)**2*ys(3)**2*ys(4) + 100*ys(1)**2*ys(3)*ys(4)**2 + 75*ys(1)*ys(2)**4 & + & + 180*ys(1)*ys(2)**3*ys(3) + 60*ys(1)*ys(2)**3*ys(4) + 135*ys(1)*ys(2)**2*ys(3) & + & **2 + 90*ys(1)*ys(2)**2*ys(3)*ys(4) + 15*ys(1)*ys(2)**2*ys(4)**2 + 30*ys(1)*ys(2) & + & *ys(3)**3 + 30*ys(1)*ys(2)*ys(3)**2*ys(4) + 10*ys(1)*ys(2)*ys(3)*ys(4)**2 & + & + 30*ys(2)**5 + 90*ys(2)**4*ys(3) + 30*ys(2)**4*ys(4) + 90*ys(2)**3*ys(3)**2 & + & + 60*ys(2)**3*ys(3)*ys(4) + 10*ys(2)**3*ys(4)**2 + 30*ys(2)**2*ys(3)**3 & + & + 30*ys(2)**2*ys(3)**2*ys(4) + 10*ys(2)**2*ys(3)*ys(4)**2))/(5*(ys(2) + ys(3)) & + & *(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3))*(ys(2) + ys(3) + ys(4))**2*(ys(1) & + & + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 0, & - & 2) = (4*y(1)**2*(1767*y(1)**4 + 725*y(1)**3*y(2) + 415*y(1)**3*y(3) + 105*y(4) & - & *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) & - & + 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) & - & **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) & - & + 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) & - & *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) & - & *y(2)*y(3)**2))/(5*(y(1) + y(2))*(y(3) + y(4))*(y(1) + y(2) + y(3))*(y(2) + y(3) & - & + y(4))*(y(1) + y(2) + y(3) + y(4))**2) + & 2) = (4*ys(1)**2*(1767*ys(1)**4 + 725*ys(1)**3*ys(2) + 415*ys(1)**3*ys(3) & + & + 105*ys(4)*ys(1)**3 + 665*ys(1)**2*ys(2)**2 + 775*ys(1)**2*ys(2)*ys(3) & + & + 220*ys(4)*ys(1)**2*ys(2) + 215*ys(1)**2*ys(3)**2 + 110*ys(4)*ys(1)**2*ys(3) & + & + 75*ys(1)*ys(2)**3 + 130*ys(1)*ys(2)**2*ys(3) + 35*ys(4)*ys(1)*ys(2)**2 & + & + 60*ys(1)*ys(2)*ys(3)**2 + 35*ys(4)*ys(1)*ys(2)*ys(3) + 5*ys(1)*ys(3)**3 & + & + 5*ys(4)*ys(1)*ys(3)**2 + 30*ys(2)**4 + 70*ys(2)**3*ys(3) + 20*ys(4)*ys(2)**3 & + & + 50*ys(2)**2*ys(3)**2 + 30*ys(4)*ys(2)**2*ys(3) + 10*ys(2)*ys(3)**3 + 10*ys(4) & + & *ys(2)*ys(3)**2))/(5*(ys(1) + ys(2))*(ys(3) + ys(4))*(ys(1) + ys(2) + ys(3)) & + & *(ys(2) + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 0, & - & 3) = (4*y(1)**2*(831*y(1)**6 + 3624*y(1)**5*y(2) + 3524*y(1)**5*y(3) + 1762*y(1) & - & **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) & - & + 4224*y(1)**4*y(3)**2 + 4224*y(1)**4*y(3)*y(4) + 1081*y(1)**4*y(4)**2 & - & + 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) & - & + 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) & - & *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) & - & *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) & - & + 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) & - & **2*y(3)*y(4) + 1390*y(1)**2*y(2)**2*y(4)**2 + 2490*y(1)**2*y(2)*y(3)**3 & - & + 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) & - & **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) & - & **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) & - & *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) & - & **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) & - & **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 & - & + 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) & - & + 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 & - & + 45*y(2)**6 + 180*y(2)**5*y(3) + 90*y(2)**5*y(4) + 270*y(2)**4*y(3)**2 & - & + 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) & - & **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) & - & **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) & - & **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)) & - & **2*(y(2) + y(3) + y(4))**2*(y(1) + y(2) + y(3) + y(4))**2) + & 3) = (4*ys(1)**2*(831*ys(1)**6 + 3624*ys(1)**5*ys(2) + 3524*ys(1)**5*ys(3) & + & + 1762*ys(1)**5*ys(4) + 4884*ys(1)**4*ys(2)**2 + 9058*ys(1)**4*ys(2)*ys(3) & + & + 4529*ys(1)**4*ys(2)*ys(4) + 4224*ys(1)**4*ys(3)**2 + 4224*ys(1)**4*ys(3)*ys(4) & + & + 1081*ys(1)**4*ys(4)**2 + 2565*ys(1)**3*ys(2)**3 + 6120*ys(1)**3*ys(2)**2*ys(3) & + & + 3060*ys(1)**3*ys(2)**2*ys(4) + 4755*ys(1)**3*ys(2)*ys(3)**2 + 4755*ys(1) & + & **3*ys(2)*ys(3)*ys(4) + 1315*ys(1)**3*ys(2)*ys(4)**2 + 1200*ys(1)**3*ys(3)**3 & + & + 1800*ys(1)**3*ys(3)**2*ys(4) + 1000*ys(1)**3*ys(3)*ys(4)**2 + 200*ys(1) & + & **3*ys(4)**3 + 1395*ys(1)**2*ys(2)**4 + 4380*ys(1)**2*ys(2)**3*ys(3) + 2190*ys(1) & + & **2*ys(2)**3*ys(4) + 5025*ys(1)**2*ys(2)**2*ys(3)**2 + 5025*ys(1)**2*ys(2) & + & **2*ys(3)*ys(4) + 1390*ys(1)**2*ys(2)**2*ys(4)**2 + 2490*ys(1)**2*ys(2)*ys(3)**3 & + & + 3735*ys(1)**2*ys(2)*ys(3)**2*ys(4) + 2075*ys(1)**2*ys(2)*ys(3)*ys(4)**2 & + & + 415*ys(1)**2*ys(2)*ys(4)**3 + 450*ys(1)**2*ys(3)**4 + 900*ys(1)**2*ys(3) & + & **3*ys(4) + 750*ys(1)**2*ys(3)**2*ys(4)**2 + 300*ys(1)**2*ys(3)*ys(4)**3 & + & + 50*ys(1)**2*ys(4)**4 + 135*ys(1)*ys(2)**5 + 450*ys(1)*ys(2)**4*ys(3) & + & + 225*ys(1)*ys(2)**4*ys(4) + 540*ys(1)*ys(2)**3*ys(3)**2 + 540*ys(1)*ys(2) & + & **3*ys(3)*ys(4) + 150*ys(1)*ys(2)**3*ys(4)**2 + 270*ys(1)*ys(2)**2*ys(3)**3 & + & + 405*ys(1)*ys(2)**2*ys(3)**2*ys(4) + 225*ys(1)*ys(2)**2*ys(3)*ys(4)**2 & + & + 45*ys(1)*ys(2)**2*ys(4)**3 + 45*ys(1)*ys(2)*ys(3)**4 + 90*ys(1)*ys(2)*ys(3) & + & **3*ys(4) + 75*ys(1)*ys(2)*ys(3)**2*ys(4)**2 + 30*ys(1)*ys(2)*ys(3)*ys(4)**3 & + & + 5*ys(1)*ys(2)*ys(4)**4 + 45*ys(2)**6 + 180*ys(2)**5*ys(3) + 90*ys(2)**5*ys(4) & + & + 270*ys(2)**4*ys(3)**2 + 270*ys(2)**4*ys(3)*ys(4) + 75*ys(2)**4*ys(4)**2 & + & + 180*ys(2)**3*ys(3)**3 + 270*ys(2)**3*ys(3)**2*ys(4) + 150*ys(2)**3*ys(3)*ys(4) & + & **2 + 30*ys(2)**3*ys(4)**3 + 45*ys(2)**2*ys(3)**4 + 90*ys(2)**2*ys(3)**3*ys(4) & + & + 75*ys(2)**2*ys(3)**2*ys(4)**2 + 30*ys(2)**2*ys(3)*ys(4)**3 + 5*ys(2)**2*ys(4) & + & **4))/(5*(ys(2) + ys(3))**2*(ys(1) + ys(2) + ys(3))**2*(ys(2) + ys(3) + ys(4)) & + & **2*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 0, & - & 4) = -(4*y(1)**2*(1767*y(1)**5 + 4464*y(1)**4*y(2) + 4154*y(1)**4*y(3) & - & + 2077*y(1)**4*y(4) + 2655*y(1)**3*y(2)**2 + 4010*y(1)**3*y(2)*y(3) + 2005*y(1) & - & **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) & - & **2 + 1800*y(1)**2*y(2)**3 + 4000*y(1)**2*y(2)**2*y(3) + 2000*y(1)**2*y(2) & - & **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) & - & **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) & - & **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) & - & + 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) & - & + 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) & - & + 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) & - & *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 & - & + 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) & - & *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) & - & + 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) & - & **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)) & - & *(y(2) + y(3))*(y(1) + y(2) + y(3))**2*(y(2) + y(3) + y(4))*(y(1) + y(2) + y(3) & - & + y(4))**2) + & 4) = -(4*ys(1)**2*(1767*ys(1)**5 + 4464*ys(1)**4*ys(2) + 4154*ys(1)**4*ys(3) & + & + 2077*ys(1)**4*ys(4) + 2655*ys(1)**3*ys(2)**2 + 4010*ys(1)**3*ys(2)*ys(3) & + & + 2005*ys(1)**3*ys(2)*ys(4) + 1460*ys(1)**3*ys(3)**2 + 1460*ys(1)**3*ys(3)*ys(4) & + & + 415*ys(1)**3*ys(4)**2 + 1800*ys(1)**2*ys(2)**3 + 4000*ys(1)**2*ys(2)**2*ys(3) & + & + 2000*ys(1)**2*ys(2)**2*ys(4) + 2850*ys(1)**2*ys(2)*ys(3)**2 + 2850*ys(1) & + & **2*ys(2)*ys(3)*ys(4) + 790*ys(1)**2*ys(2)*ys(4)**2 + 650*ys(1)**2*ys(3)**3 & + & + 975*ys(1)**2*ys(3)**2*ys(4) + 535*ys(1)**2*ys(3)*ys(4)**2 + 105*ys(1)**2*ys(4) & + & **3 + 270*ys(1)*ys(2)**4 + 720*ys(1)*ys(2)**3*ys(3) + 360*ys(1)*ys(2)**3*ys(4) & + & + 645*ys(1)*ys(2)**2*ys(3)**2 + 645*ys(1)*ys(2)**2*ys(3)*ys(4) + 165*ys(1)*ys(2) & + & **2*ys(4)**2 + 210*ys(1)*ys(2)*ys(3)**3 + 315*ys(1)*ys(2)*ys(3)**2*ys(4) & + & + 155*ys(1)*ys(2)*ys(3)*ys(4)**2 + 25*ys(1)*ys(2)*ys(4)**3 + 15*ys(1)*ys(3)**4 & + & + 30*ys(1)*ys(3)**3*ys(4) + 20*ys(1)*ys(3)**2*ys(4)**2 + 5*ys(1)*ys(3)*ys(4)**3 & + & + 90*ys(2)**5 + 300*ys(2)**4*ys(3) + 150*ys(2)**4*ys(4) + 360*ys(2)**3*ys(3)**2 & + & + 360*ys(2)**3*ys(3)*ys(4) + 90*ys(2)**3*ys(4)**2 + 180*ys(2)**2*ys(3)**3 & + & + 270*ys(2)**2*ys(3)**2*ys(4) + 130*ys(2)**2*ys(3)*ys(4)**2 + 20*ys(2)**2*ys(4) & + & **3 + 30*ys(2)*ys(3)**4 + 60*ys(2)*ys(3)**3*ys(4) + 40*ys(2)*ys(3)**2*ys(4)**2 & + & + 10*ys(2)*ys(3)*ys(4)**3))/(5*(ys(1) + ys(2))*(ys(2) + ys(3))*(ys(1) + ys(2) & + & + ys(3))**2*(ys(2) + ys(3) + ys(4))*(ys(1) + ys(2) + ys(3) + ys(4))**2) beta_coef_${XYZ}$ (i + 1, 0, & - & 5) = (4*y(1)**2*(996*y(1)**4 + 675*y(1)**3*y(2) + 450*y(1)**3*y(3) + 225*y(1) & - & **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) & - & + 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) & - & *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 & - & + 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) & - & **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) & - & + 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) & - & **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) & - & + 5*y(3)**2*y(4)**2))/(5*(y(1) + y(2))**2*(y(1) + y(2) + y(3))**2*(y(1) + y(2) & - & + y(3) + y(4))**2) + & 5) = (4*ys(1)**2*(996*ys(1)**4 + 675*ys(1)**3*ys(2) + 450*ys(1)**3*ys(3) & + & + 225*ys(1)**3*ys(4) + 600*ys(1)**2*ys(2)**2 + 800*ys(1)**2*ys(2)*ys(3) & + & + 400*ys(1)**2*ys(2)*ys(4) + 260*ys(1)**2*ys(3)**2 + 260*ys(1)**2*ys(3)*ys(4) & + & + 60*ys(1)**2*ys(4)**2 + 135*ys(1)*ys(2)**3 + 270*ys(1)*ys(2)**2*ys(3) & + & + 135*ys(1)*ys(2)**2*ys(4) + 165*ys(1)*ys(2)*ys(3)**2 + 165*ys(1)*ys(2)*ys(3) & + & *ys(4) + 30*ys(1)*ys(2)*ys(4)**2 + 30*ys(1)*ys(3)**3 + 45*ys(1)*ys(3)**2*ys(4) & + & + 15*ys(1)*ys(3)*ys(4)**2 + 45*ys(2)**4 + 120*ys(2)**3*ys(3) + 60*ys(2)**3*ys(4) & + & + 110*ys(2)**2*ys(3)**2 + 110*ys(2)**2*ys(3)*ys(4) + 20*ys(2)**2*ys(4)**2 & + & + 40*ys(2)*ys(3)**3 + 60*ys(2)*ys(3)**2*ys(4) + 20*ys(2)*ys(3)*ys(4)**2 + 5*ys(3) & + & **4 + 10*ys(3)**3*ys(4) + 5*ys(3)**2*ys(4)**2))/(5*(ys(1) + ys(2))**2*(ys(1) & + & + ys(2) + ys(3))**2*(ys(1) + ys(2) + ys(3) + ys(4))**2) end do else ! (Fu, et al., 2016) Table 2 (for right flux) @@ -1204,8 +1240,8 @@ contains delta(:) = 0._wp beta(:) = weno_eps - if (teno) v = v_rs_ws_${XYZ}$ (j - 3:j + 3,k, l, & - & i) ! temporary field value array for clarity + ! temporary field value array for clarity + if (teno) v = v_rs_ws_${XYZ}$ (j - 3:j + 3,k, l, i) if (.not. teno) then dvd(2) = v_rs_ws_${XYZ}$ (j + 3, k, l, i) - v_rs_ws_${XYZ}$ (j + 2, k, l, i) @@ -1305,8 +1341,8 @@ contains tau = abs(beta(3) - beta(0)) ! Equation 50 $:GPU_LOOP(parallelism='[seq]') do q = 0, weno_num_stencils - alpha(q) = d_cbL_${XYZ}$ (q, & - & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability + ! wenoz_q = 2,3,4 for stability + alpha(q) = d_cbL_${XYZ}$ (q, j)*(1._wp + (tau/beta(q))**wenoz_q) end do else if (teno) then #:if not MFC_CASE_OPTIMIZATION or weno_num_stencils > 3 @@ -1379,8 +1415,8 @@ contains else if (wenoz) then $:GPU_LOOP(parallelism='[seq]') do q = 0, weno_num_stencils - alpha(q) = d_cbR_${XYZ}$ (q, & - & j)*(1._wp + (tau/beta(q))**wenoz_q) ! wenoz_q = 2,3,4 for stability + ! wenoz_q = 2,3,4 for stability + alpha(q) = d_cbR_${XYZ}$ (q, j)*(1._wp + (tau/beta(q))**wenoz_q) end do else if (teno) then $:GPU_LOOP(parallelism='[seq]') diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index 65c49f8304..21e04b996c 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -189,9 +189,9 @@ def __get_analytic_ic_fpp(self, print: bool) -> str: # values from the case file def rhs_replace(match): return { - "x": "x_cc(i)", - "y": "y_cc(j)", - "z": "z_cc(k)", + "x": "x%cc(i)", + "y": "y%cc(j)", + "z": "z%cc(k)", "xc": f"patch_icpp({pid})%x_centroid", "yc": f"patch_icpp({pid})%y_centroid", "zc": f"patch_icpp({pid})%z_centroid", @@ -271,9 +271,9 @@ def __get_analytic_mib_fpp(self, print: bool) -> str: # values from the case file def rhs_replace(match): return { - "x": "x_cc(i)", - "y": "y_cc(j)", - "z": "z_cc(k)", + "x": "x%cc(i)", + "y": "y%cc(j)", + "z": "z%cc(k)", "t": "mytime", "r": f"patch_ib({pid})%radius", "e": f"{math.e}", diff --git a/toolchain/mfc/case_validator.py b/toolchain/mfc/case_validator.py index 05a3fee92c..30a0d3c577 100644 --- a/toolchain/mfc/case_validator.py +++ b/toolchain/mfc/case_validator.py @@ -1300,15 +1300,15 @@ def check_grid_stretching(self): continue a = self.get(f"a_{direction}") - coord_a = self.get(f"{direction}_a") - coord_b = self.get(f"{direction}_b") + coord_a = self.get(f"{direction}_stretch%beg") + coord_b = self.get(f"{direction}_stretch%end") self.prohibit(old_grid, f"old_grid and stretch_{direction} are incompatible") self.prohibit(a is None, f"a_{direction} must be set with stretch_{direction} enabled") - self.prohibit(coord_a is None, f"{direction}_a must be set with stretch_{direction} enabled") - self.prohibit(coord_b is None, f"{direction}_b must be set with stretch_{direction} enabled") + self.prohibit(coord_a is None, f"{direction}_stretch%%beg must be set with stretch_{direction} enabled") + self.prohibit(coord_b is None, f"{direction}_stretch%%end must be set with stretch_{direction} enabled") if coord_a is not None and coord_b is not None: - self.prohibit(coord_a >= coord_b, f"{direction}_a must be less than {direction}_b with stretch_{direction} enabled") + self.prohibit(coord_a >= coord_b, f"{direction}_stretch%%beg must be less than {direction}_stretch%%end with stretch_{direction} enabled") def check_perturb_density(self): """Checks initial partial density perturbation constraints (pre-process)""" diff --git a/toolchain/mfc/params/definitions.py b/toolchain/mfc/params/definitions.py index c8db5547d0..737d701d89 100644 --- a/toolchain/mfc/params/definitions.py +++ b/toolchain/mfc/params/definitions.py @@ -171,12 +171,12 @@ def _fc(name: str, default: int) -> int: "a_x": "Grid stretching rate in x", "a_y": "Grid stretching rate in y", "a_z": "Grid stretching rate in z", - "x_a": "Stretching start (negative x)", - "x_b": "Stretching start (positive x)", - "y_a": "Stretching start (negative y)", - "y_b": "Stretching start (positive y)", - "z_a": "Stretching start (negative z)", - "z_b": "Stretching start (positive z)", + "x_stretch%beg": "Stretching start (negative x)", + "x_stretch%end": "Stretching start (positive x)", + "y_stretch%beg": "Stretching start (negative y)", + "y_stretch%end": "Stretching start (positive y)", + "z_stretch%beg": "Stretching start (negative z)", + "z_stretch%end": "Stretching start (positive z)", "loops_x": "Stretching iterations in x", "loops_y": "Stretching iterations in y", "loops_z": "Stretching iterations in z", @@ -268,21 +268,21 @@ def _fc(name: str, default: int) -> int: "format": "Output format", "precision": "Output precision", # Body forces - "bf_x": "Enable body force in x", - "bf_y": "Enable body force in y", - "bf_z": "Enable body force in z", - "k_x": "Body force wavenumber in x", - "k_y": "Body force wavenumber in y", - "k_z": "Body force wavenumber in z", - "w_x": "Body force frequency in x", - "w_y": "Body force frequency in y", - "w_z": "Body force frequency in z", - "p_x": "Body force phase in x", - "p_y": "Body force phase in y", - "p_z": "Body force phase in z", - "g_x": "Gravitational acceleration in x", - "g_y": "Gravitational acceleration in y", - "g_z": "Gravitational acceleration in z", + "bf_x%enabled": "Enable body force in x", + "bf_y%enabled": "Enable body force in y", + "bf_z%enabled": "Enable body force in z", + "bf_x%k": "Body force wavenumber in x", + "bf_y%k": "Body force wavenumber in y", + "bf_z%k": "Body force wavenumber in z", + "bf_x%w": "Body force frequency in x", + "bf_y%w": "Body force frequency in y", + "bf_z%w": "Body force frequency in z", + "bf_x%p": "Body force phase in x", + "bf_y%p": "Body force phase in y", + "bf_z%p": "Body force phase in z", + "bf_x%g": "Gravitational acceleration in x", + "bf_y%g": "Gravitational acceleration in y", + "bf_z%g": "Gravitational acceleration in z", # More output "E_wrt": "Write energy field", "c_wrt": "Write sound speed field", @@ -744,32 +744,32 @@ def get_value_label(param_name: str, value: int) -> str: }, "stretch_x": { "when_true": { - "requires": ["a_x", "x_a", "x_b"], + "requires": ["a_x", "x_stretch%beg", "x_stretch%end"], } }, "stretch_y": { "when_true": { - "requires": ["a_y", "y_a", "y_b"], + "requires": ["a_y", "y_stretch%beg", "y_stretch%end"], } }, "stretch_z": { "when_true": { - "requires": ["a_z", "z_a", "z_b"], + "requires": ["a_z", "z_stretch%beg", "z_stretch%end"], } }, - "bf_x": { + "bf_x%enabled": { "when_true": { - "requires": ["k_x", "w_x", "p_x", "g_x"], + "requires": ["bf_x%k", "bf_x%w", "bf_x%p", "bf_x%g"], } }, - "bf_y": { + "bf_y%enabled": { "when_true": { - "requires": ["k_y", "w_y", "p_y", "g_y"], + "requires": ["bf_y%k", "bf_y%w", "bf_y%p", "bf_y%g"], } }, - "bf_z": { + "bf_z%enabled": { "when_true": { - "requires": ["k_z", "w_z", "p_z", "g_z"], + "requires": ["bf_z%k", "bf_z%w", "bf_z%p", "bf_z%g"], } }, "teno": { @@ -854,8 +854,8 @@ def _load(): for n in ["stretch_x", "stretch_y", "stretch_z"]: _r(n, LOG, {"grid"}) for d in ["x", "y", "z"]: - _r(f"{d}_a", REAL, {"grid"}) - _r(f"{d}_b", REAL, {"grid"}) + _r(f"{d}_stretch%beg", REAL, {"grid"}) + _r(f"{d}_stretch%end", REAL, {"grid"}) _r(f"a_{d}", REAL, {"grid"}) _r(f"loops_{d}", INT, {"grid"}) _r(f"{d}_domain%beg", REAL, {"grid"}) @@ -1076,11 +1076,11 @@ def _load(): # Body force for d in ["x", "y", "z"]: - _r(f"g_{d}", REAL, math=r"\f$g_" + d + r"\f$") - _r(f"k_{d}", REAL, math=r"\f$k_" + d + r"\f$") - _r(f"w_{d}", REAL, math=r"\f$\omega_" + d + r"\f$") - _r(f"p_{d}", REAL, math=r"\f$\phi_" + d + r"\f$") - _r(f"bf_{d}", LOG) + _r(f"bf_{d}%g", REAL, math=r"\f$g_" + d + r"\f$") + _r(f"bf_{d}%k", REAL, math=r"\f$k_" + d + r"\f$") + _r(f"bf_{d}%w", REAL, math=r"\f$\omega_" + d + r"\f$") + _r(f"bf_{d}%p", REAL, math=r"\f$\phi_" + d + r"\f$") + _r(f"bf_{d}%enabled", LOG) # INDEXED PARAMETERS diff --git a/toolchain/mfc/params/descriptions.py b/toolchain/mfc/params/descriptions.py index 8ceab7f96c..630085bade 100644 --- a/toolchain/mfc/params/descriptions.py +++ b/toolchain/mfc/params/descriptions.py @@ -26,12 +26,12 @@ "a_x": "Rate of grid stretching in the x-direction", "a_y": "Rate of grid stretching in the y-direction", "a_z": "Rate of grid stretching in the z-direction", - "x_a": "Start of stretching in negative x-direction", - "x_b": "Start of stretching in positive x-direction", - "y_a": "Start of stretching in negative y-direction", - "y_b": "Start of stretching in positive y-direction", - "z_a": "Start of stretching in negative z-direction", - "z_b": "Start of stretching in positive z-direction", + "x_stretch%beg": "Start of stretching in negative x-direction", + "x_stretch%end": "Start of stretching in positive x-direction", + "y_stretch%beg": "Start of stretching in negative y-direction", + "y_stretch%end": "Start of stretching in positive y-direction", + "z_stretch%beg": "Start of stretching in negative z-direction", + "z_stretch%end": "Start of stretching in positive z-direction", "loops_x": "Number of times to apply grid stretching in x", "loops_y": "Number of times to apply grid stretching in y", "loops_z": "Number of times to apply grid stretching in z", @@ -214,21 +214,21 @@ "lag_header": "Enable Lagrangian output header", "chem_wrt_T": "Write temperature field for chemistry", # Body force parameters - "bf_x": "Enable body force in x-direction", - "bf_y": "Enable body force in y-direction", - "bf_z": "Enable body force in z-direction", - "g_x": "Body force magnitude in x-direction", - "g_y": "Body force magnitude in y-direction", - "g_z": "Body force magnitude in z-direction", - "k_x": "Body force wavenumber in x-direction", - "k_y": "Body force wavenumber in y-direction", - "k_z": "Body force wavenumber in z-direction", - "w_x": "Body force frequency in x-direction", - "w_y": "Body force frequency in y-direction", - "w_z": "Body force frequency in z-direction", - "p_x": "Body force phase in x-direction", - "p_y": "Body force phase in y-direction", - "p_z": "Body force phase in z-direction", + "bf_x%enabled": "Enable body force in x-direction", + "bf_y%enabled": "Enable body force in y-direction", + "bf_z%enabled": "Enable body force in z-direction", + "bf_x%g": "Body force magnitude in x-direction", + "bf_y%g": "Body force magnitude in y-direction", + "bf_z%g": "Body force magnitude in z-direction", + "bf_x%k": "Body force wavenumber in x-direction", + "bf_y%k": "Body force wavenumber in y-direction", + "bf_z%k": "Body force wavenumber in z-direction", + "bf_x%w": "Body force frequency in x-direction", + "bf_y%w": "Body force frequency in y-direction", + "bf_z%w": "Body force frequency in z-direction", + "bf_x%p": "Body force phase in x-direction", + "bf_y%p": "Body force phase in y-direction", + "bf_z%p": "Body force phase in z-direction", # Output flags "mom_wrt": "Write momentum to database", "flux_wrt": "Write flux data", diff --git a/toolchain/mfc/params/namelist_parser.py b/toolchain/mfc/params/namelist_parser.py index 52385255d3..b013807583 100644 --- a/toolchain/mfc/params/namelist_parser.py +++ b/toolchain/mfc/params/namelist_parser.py @@ -115,14 +115,14 @@ "thermal", "viscous", "weno_order", - "x_a", - "x_b", + "x_stretch%beg", + "x_stretch%end", "x_domain", - "y_a", - "y_b", + "y_stretch%beg", + "y_stretch%end", "y_domain", - "z_a", - "z_b", + "z_stretch%beg", + "z_stretch%end", "z_domain", }, "simulation": { @@ -144,9 +144,9 @@ "bc_x", "bc_y", "bc_z", - "bf_x", - "bf_y", - "bf_z", + "bf_x%enabled", + "bf_y%enabled", + "bf_z%enabled", "bub_pp", "bubble_model", "bubbles_euler", @@ -165,9 +165,9 @@ "fft_wrt", "file_per_process", "fluid_pp", - "g_x", - "g_y", - "g_z", + "bf_x%g", + "bf_y%g", + "bf_z%g", "hyper_cleaning", "hyper_cleaning_speed", "hyper_cleaning_tau", @@ -184,9 +184,9 @@ "int_comp", "integral", "integral_wrt", - "k_x", - "k_y", - "k_z", + "bf_x%k", + "bf_y%k", + "bf_z%k", "lag_params", "low_Mach", "m", @@ -214,9 +214,9 @@ "nv_uvm_out_of_core", "nv_uvm_pref_gpu", "p", - "p_x", - "p_y", - "p_z", + "bf_x%p", + "bf_y%p", + "bf_z%p", "palpha_eps", "parallel_io", "patch_ib", @@ -254,9 +254,9 @@ "thermal", "time_stepper", "viscous", - "w_x", - "w_y", - "w_z", + "bf_x%w", + "bf_y%w", + "bf_z%w", "wave_speeds", "weno_Re_flux", "weno_avg", @@ -264,14 +264,14 @@ "weno_order", "wenoz", "wenoz_q", - "x_a", - "x_b", + "x_stretch%beg", + "x_stretch%end", "x_domain", - "y_a", - "y_b", + "y_stretch%beg", + "y_stretch%end", "y_domain", - "z_a", - "z_b", + "z_stretch%beg", + "z_stretch%end", "z_domain", }, "post_process": { diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index b72584a032..30e9d4a166 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -1186,13 +1186,13 @@ def alter_hypoelasticity(dimInfo): def alter_body_forces(dimInfo): ndims = len(dimInfo[0]) - stack.push("Bodyforces", {"bf_x": "T", "k_x": 1, "w_x": 1, "p_x": 1, "g_x": 10}) + stack.push("Bodyforces", {"bf_x%enabled": "T", "bf_x%k": 1, "bf_x%w": 1, "bf_x%p": 1, "bf_x%g": 10}) if ndims >= 2: - stack.push("", {"bf_y": "T", "k_y": 1, "w_y": 1, "p_y": 1, "g_y": 10}) + stack.push("", {"bf_y%enabled": "T", "bf_y%k": 1, "bf_y%w": 1, "bf_y%p": 1, "bf_y%g": 10}) if ndims == 3: - stack.push("", {"bf_z": "T", "k_z": 1, "w_z": 1, "p_z": 1, "g_z": 10}) + stack.push("", {"bf_z%enabled": "T", "bf_z%k": 1, "bf_z%w": 1, "bf_z%p": 1, "bf_z%g": 10}) cases.append(define_case_d(stack, "", {})) @@ -2291,18 +2291,18 @@ def kernel_golden_tests(): **base_3d, "stretch_x": "T", "a_x": 2.0, - "x_a": 0.3, - "x_b": 0.7, + "x_stretch%beg": 0.3, + "x_stretch%end": 0.7, "loops_x": 1, "stretch_y": "T", "a_y": 2.0, - "y_a": 0.3, - "y_b": 0.7, + "y_stretch%beg": 0.3, + "y_stretch%end": 0.7, "loops_y": 1, "stretch_z": "T", "a_z": 2.0, - "z_a": 0.3, - "z_b": 0.7, + "z_stretch%beg": 0.3, + "z_stretch%end": 0.7, "loops_z": 1, # Enlarge x/y coverage for all patches (stretched domain reaches ~1.39) "patch_icpp(1)%x_centroid": 0.75, @@ -2381,8 +2381,8 @@ def kernel_golden_tests(): # x-stretching creates non-uniform cells at the bubble interface "stretch_x": "T", "a_x": 2.0, - "x_a": 0.3, - "x_b": 0.7, + "x_stretch%beg": 0.3, + "x_stretch%end": 0.7, "loops_x": 1, }, ) diff --git a/toolchain/pyproject.toml b/toolchain/pyproject.toml index fe9b7b7fee..0d85419f9c 100644 --- a/toolchain/pyproject.toml +++ b/toolchain/pyproject.toml @@ -24,7 +24,7 @@ dependencies = [ # Code Health "typos", "ruff", - "ffmt", + "ffmt==0.4.0", "ansi2txt", # Profiling