Commit 7fa22ec0 authored by Jannis Teunissen's avatar Jannis Teunissen

Use DSLICE preprocessor for multidimensional array slicing

parent b50b9874
......@@ -1066,20 +1066,9 @@ contains
ix1 = ref_buffer
end where
#if NDIM == 1
if (any(cell_flags(ix0(1):ix1(1)) == af_do_ref)) then
ref_flags(nb_id) = af_do_ref
end if
#elif NDIM == 2
if (any(cell_flags(ix0(1):ix1(1), ix0(2):ix1(2)) == af_do_ref)) then
if (any(cell_flags(DSLICE(ix0, ix1)) == af_do_ref)) then
ref_flags(nb_id) = af_do_ref
end if
#elif NDIM == 3
if (any(cell_flags(ix0(1):ix1(1), ix0(2):ix1(2), &
ix0(3):ix1(3)) == af_do_ref)) then
ref_flags(nb_id) = af_do_ref
end if
#endif
end do; CLOSE_DO
end subroutine cell_to_ref_flags
......
......@@ -686,16 +686,8 @@ contains
nlo = lo - dnb * box%n_cell
nhi = hi - dnb * box%n_cell
#if NDIM == 1
box%cc(lo(1):hi(1), iv) = &
box_nb%cc(nlo(1):nhi(1), iv)
#elif NDIM == 2
box%cc(lo(1):hi(1), lo(2):hi(2), iv) = &
box_nb%cc(nlo(1):nhi(1), nlo(2):nhi(2), iv)
#elif NDIM == 3
box%cc(lo(1):hi(1), lo(2):hi(2), lo(3):hi(3), iv) = &
box_nb%cc(nlo(1):nhi(1), nlo(2):nhi(2), nlo(3):nhi(3), iv)
#endif
box%cc(DSLICE(lo, hi), iv) = &
box_nb%cc(DSLICE(nlo, nhi), iv)
end subroutine copy_from_nb
!> Get array of cell-centered variables with multiple ghost cells, excluding corners
......@@ -735,17 +727,9 @@ contains
nlo = lo - dnb * tree%n_cell
nhi = hi - dnb * tree%n_cell
#if NDIM == 1
cc(lo(1):hi(1), :) = &
tree%boxes(nb_id)%cc(nlo(1):nhi(1), ivs)
#elif NDIM == 2
cc(lo(1):hi(1), lo(2):hi(2), :) = &
tree%boxes(nb_id)%cc(nlo(1):nhi(1), nlo(2):nhi(2), ivs)
#elif NDIM == 3
cc(lo(1):hi(1), lo(2):hi(2), lo(3):hi(3), :) = &
tree%boxes(nb_id)%cc(nlo(1):nhi(1), nlo(2):nhi(2), &
nlo(3):nhi(3), ivs)
#endif
cc(DSLICE(lo, hi), :) = &
tree%boxes(nb_id)%cc(DSLICE(nlo, nhi), ivs)
else if (nb_id == af_no_box) then
! Refinement boundary
do i = 1, size(ivs)
......
......@@ -1145,53 +1145,20 @@ contains
! Dirichlet value at cell face, so compute gradient over h/2
! E.g. 1 -2 1 becomes 0 -3 1 for a 1D Laplacian
! The boundary condition is incorporated in the right-hand side
#if NDIM == 1
stencil(1, lo(1):hi(1)) = &
stencil(1, lo(1):hi(1)) - &
stencil(nb+1, lo(1):hi(1))
bc_to_rhs(:, nb) = -2 * stencil(nb+1, lo(1):hi(1))
stencil(nb+1, lo(1):hi(1)) = 0.0_dp
#elif NDIM == 2
stencil(1, lo(1):hi(1), lo(2):hi(2)) = &
stencil(1, lo(1):hi(1), lo(2):hi(2)) - &
stencil(nb+1, lo(1):hi(1), lo(2):hi(2))
bc_to_rhs(:, nb) = &
pack(-2 * stencil(nb+1, lo(1):hi(1), lo(2):hi(2)), .true.)
stencil(nb+1, lo(1):hi(1), lo(2):hi(2)) = 0.0_dp
#elif NDIM == 3
stencil(1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) = &
stencil(1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) - &
stencil(nb+1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3))
bc_to_rhs(:, nb) = &
pack(-2 * stencil(nb+1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)), .true.)
stencil(nb+1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) = 0.0_dp
#endif
stencil(1, DSLICE(lo, hi)) = &
stencil(1, DSLICE(lo, hi)) - &
stencil(nb+1, DSLICE(lo, hi))
bc_to_rhs(:, nb) = pack(-2 * stencil(nb+1, DSLICE(lo, hi)), .true.)
stencil(nb+1, DSLICE(lo, hi)) = 0.0_dp
case (af_bc_neumann)
! E.g. 1 -2 1 becomes 0 -1 1 for a 1D Laplacian
#if NDIM == 1
stencil(1, lo(1):hi(1)) = &
stencil(1, lo(1):hi(1)) + &
stencil(nb+1, lo(1):hi(1))
bc_to_rhs(:, nb) = -stencil(nb+1, lo(1):hi(1)) * &
box%dr(nb_dim) * af_neighb_high_pm(nb)
stencil(nb+1, lo(1):hi(1)) = 0.0_dp
#elif NDIM == 2
stencil(1, lo(1):hi(1), lo(2):hi(2)) = &
stencil(1, lo(1):hi(1), lo(2):hi(2)) + &
stencil(nb+1, lo(1):hi(1), lo(2):hi(2))
bc_to_rhs(:, nb) = &
-pack(stencil(nb+1, lo(1):hi(1), lo(2):hi(2)) * &
box%dr(nb_dim), .true.) * af_neighb_high_pm(nb)
stencil(nb+1, lo(1):hi(1), lo(2):hi(2)) = 0.0_dp
#elif NDIM == 3
stencil(1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) = &
stencil(1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) + &
stencil(nb+1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3))
stencil(1, DSLICE(lo, hi)) = &
stencil(1, DSLICE(lo, hi)) + &
stencil(nb+1, DSLICE(lo, hi))
bc_to_rhs(:, nb) = &
-pack(stencil(nb+1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) * &
-pack(stencil(nb+1, DSLICE(lo, hi)) * &
box%dr(nb_dim), .true.) * af_neighb_high_pm(nb)
stencil(nb+1, lo(1):hi(1), lo(2):hi(2), lo(3):hi(3)) = 0.0_dp
#endif
stencil(nb+1, DSLICE(lo, hi)) = 0.0_dp
case default
error stop "mg_box_lpl_stencil: unsupported boundary condition"
end select
......
......@@ -312,19 +312,9 @@ contains
n1 = 0
end where
#if NDIM == 1
boxes(id)%cc(i0(1):i1(1), iv) = &
boxes(id)%cc(i0(1):i1(1), iv) + &
boxes(id)%cc(n0(1):n1(1), iv)
#elif NDIM == 2
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), iv) = &
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), iv) + &
boxes(id)%cc(n0(1):n1(1), n0(2):n1(2), iv)
#elif NDIM == 3
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), i0(3):i1(3), iv) = &
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), i0(3):i1(3), iv) + &
boxes(id)%cc(n0(1):n1(1), n0(2):n1(2), n0(3):n1(3), iv)
#endif
boxes(id)%cc(DSLICE(i0, i1), iv) = &
boxes(id)%cc(DSLICE(i0, i1), iv) + &
boxes(id)%cc(DSLICE(n0, n1), iv)
else
i0 = 1
i1 = nc
......@@ -340,19 +330,9 @@ contains
n1 = nc+1
end where
#if NDIM == 1
boxes(id)%cc(i0(1):i1(1), iv) = &
boxes(id)%cc(i0(1):i1(1), iv) + &
boxes(nb_id)%cc(n0(1):n1(1), iv)
#elif NDIM == 2
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), iv) = &
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), iv) + &
boxes(nb_id)%cc(n0(1):n1(1), n0(2):n1(2), iv)
#elif NDIM == 3
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), i0(3):i1(3), iv) = &
boxes(id)%cc(i0(1):i1(1), i0(2):i1(2), i0(3):i1(3), iv) + &
boxes(nb_id)%cc(n0(1):n1(1), n0(2):n1(2), n0(3):n1(3), iv)
#endif
boxes(id)%cc(DSLICE(i0, i1), iv) = &
boxes(id)%cc(DSLICE(i0, i1), iv) + &
boxes(nb_id)%cc(DSLICE(n0, n1), iv)
end if
end do; CLOSE_DO
end subroutine add_from_ghostcells
......
......@@ -256,19 +256,10 @@ contains
! Use the stored arrays mg%csolver%bc_to_rhs to convert the value
! at the boundary to the rhs
#if NDIM == 1
tmp(ilo(1):ihi(1)) = tmp(ilo(1):ihi(1)) + &
reshape(mg%csolver%bc_to_rhs(:, nb, n) * bc_val, [ihi - ilo + 1])
#elif NDIM == 2
tmp(ilo(1):ihi(1), ilo(2):ihi(2)) = &
tmp(ilo(1):ihi(1), ilo(2):ihi(2)) + &
reshape(mg%csolver%bc_to_rhs(:, nb, n) * bc_val, [ihi - ilo + 1])
#elif NDIM == 3
tmp(ilo(1):ihi(1), ilo(2):ihi(2), ilo(3):ihi(3)) = &
tmp(ilo(1):ihi(1), ilo(2):ihi(2), ilo(3):ihi(3)) + &
tmp(DSLICE(ilo, ihi)) = &
tmp(DSLICE(ilo, ihi)) + &
reshape(mg%csolver%bc_to_rhs(:, nb, n) * pack(bc_val, .true.), &
[ihi - ilo + 1])
#endif
end if
end do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment