gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

BOUNDARIES: Handle all direction at once in boundaries_edge_prolong().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2022-02-07 13:12:48 -03:00
parent 1bb006f091
commit 92a96a7e2f
1 changed files with 115 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
sources/boundaries.F90
View File

@ -916,9 +916,7 @@ module boundaries
end do
#endif /* NDIMS == 3 */
do idir = 1, ndims
call boundaries_edge_prolong(idir, status)
end do
call boundaries_edge_prolong(status)
call boundaries_corner_prolong(status)
@ -2434,12 +2432,11 @@ module boundaries
!
! Arguments:
!
! idir - the direction of the update;
! status - the call status;
!
!===============================================================================
!
subroutine boundaries_edge_prolong(idir, status)
subroutine boundaries_edge_prolong(status)
use blocks , only : nsides
use blocks , only : block_meta, block_data, block_leaf
@ -2455,7 +2452,6 @@ module boundaries
implicit none
integer, intent(in) :: idir
integer, intent(out) :: status
type(block_meta), pointer :: pmeta, pneigh
@ -2471,11 +2467,14 @@ module boundaries
#ifdef MPI
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
integer :: l, n, p
integer, dimension(3) :: dm, pm
integer, dimension(1) :: dm
integer, dimension(3) :: bm
integer, dimension(4) :: pm
real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
real(kind=8), dimension(:,:,:,:), allocatable :: tmp
real(kind=8), dimension(:,:) , allocatable :: sbuf, rbuf
#endif /* MPI */
logical , save :: first = .true.
@ -2509,12 +2508,12 @@ module boundaries
scount = 0
rcount = 0
dm( : ) = nghosts
dm(idir) = ncells
dm(1) = nv * nghosts**(NDIMS - 1) * ncells
pm(1) = nv
#if NDIMS == 2
dm( 3) = 1
pm(4) = 1
bm(3) = 1
#endif /* NDIMS == 2 */
pm(:) = 1
call prepare_exchange_array()
#endif /* MPI */
@ -2526,81 +2525,70 @@ module boundaries
pmeta => pleaf%meta
pdata => pmeta%data
do n = 1, NDIMS
#if NDIMS == 3
do k = 1, nsides
if (idir == 3) then
pm(3) = pmeta%pos(3) + 1
if (n == 3) then
bm(3) = pmeta%pos(3) + 1
kl = nb
ku = ne
else
pm(3) = k
kl = nlims(pm(3),1)
ku = nlims(pm(3),2)
bm(3) = k
kl = nlims(k,1)
ku = nlims(k,2)
end if
#endif /* NDIMS == 3 */
do j = 1, nsides
if (idir == 2) then
pm(2) = pmeta%pos(2) + 1
if (n == 2) then
bm(2) = pmeta%pos(2) + 1
jl = nb
ju = ne
else
pm(2) = j
jl = nlims(pm(2),1)
ju = nlims(pm(2),2)
bm(2) = j
jl = nlims(j,1)
ju = nlims(j,2)
end if
do i = 1, nsides
if (idir == 1) then
pm(1) = pmeta%pos(1) + 1
if (n == 1) then
bm(1) = pmeta%pos(1) + 1
il = nb
iu = ne
else
pm(1) = i
il = nlims(pm(1),1)
iu = nlims(pm(1),2)
bm(1) = i
il = nlims(i,1)
iu = nlims(i,2)
end if
#if NDIMS == 3
pneigh => pmeta%edges(i,j,k,idir)%ptr
pneigh => pmeta%edges(i,j,k,n)%ptr
#else /* NDIMS == 3 */
pneigh => pmeta%edges(i,j,idir)%ptr
pneigh => pmeta%edges(i,j,n)%ptr
#endif /* NDIMS == 3 */
if (associated(pneigh)) then
if (pneigh%level < pmeta%level) then
if (pmeta%update .or. pneigh%update) then
#ifdef MPI
if (pmeta%process == pneigh%process) then
if (pneigh%process == nproc) then
#endif /* MPI */
call block_edge_prolong(idir, pm, pneigh%data%q, &
pdata%q(1:nv,il:iu,jl:ju,kl:ku), status)
call block_edge_prolong(n, bm, pneigh%data%q, &
pdata%q(:,il:iu,jl:ju,kl:ku), status)
#ifdef MPI
end if
else
call append_exchange_block(pmeta, pneigh, idir, pm)
call append_exchange_block(pmeta, pneigh, n, bm)
end if
#endif /* MPI */
end if
end if
end if
end do
end do
#if NDIMS == 3
end do
#endif /* NDIMS == 3 */
end do
pleaf => pleaf%next
end do
@ -2624,8 +2612,7 @@ module boundaries
if (scount > 0 .or. rcount > 0) then
allocate(sbuf(nv,dm(1),dm(2),dm(3),scount), &
rbuf(nv,dm(1),dm(2),dm(3),rcount), stat=status)
allocate(sbuf(dm(1),scount), rbuf(dm(1),rcount), stat=status)
if (status /= 0) &
call print_message(loc, "Could not allocate the exchange buffers!")
@ -2639,13 +2626,31 @@ module boundaries
l = l + 1
pmeta => pinfo%meta
pneigh => pinfo%neigh
pdata => pinfo%neigh%data
pm(1:NDIMS) = pinfo%location(1:NDIMS)
n = pinfo%direction
i = pinfo%location(1)
j = pinfo%location(2)
#if NDIMS == 3
k = pinfo%location(3)
#endif /* NDIMS == 3 */
call block_edge_prolong(idir, pm, pneigh%data%q, &
sbuf(:,:,:,:,l), status)
bm(1:NDIMS) = nghosts
bm(n) = ncells
allocate(tmp(nv,bm(1),bm(2),bm(3)), stat=status)
if (status /= 0) &
call print_message(loc, &
"Could not allocate the temporary buffer!")
call block_edge_prolong(n, [ i, j, k ], pdata%q, tmp, status)
sbuf(:,l) = reshape(tmp, dm)
deallocate(tmp, stat=status)
if (status /= 0) &
call print_message(loc, &
"Could not deallocate the temporary buffer!")
pinfo => pinfo%prev
end do
@ -2664,35 +2669,46 @@ module boundaries
l = l + 1
pmeta => pinfo%meta
pdata => pinfo%meta%data
pm(1:NDIMS) = pinfo%location(1:NDIMS)
n = pinfo%direction
i = pinfo%location(1)
j = pinfo%location(2)
#if NDIMS == 3
k = pinfo%location(3)
#endif /* NDIMS == 3 */
if (idir == 1) then
if (n == 1) then
pm(2) = ncells
il = nb
iu = ne
else
il = nlims(pm(1),1)
iu = nlims(pm(1),2)
pm(2) = nghosts
il = nlims(i,1)
iu = nlims(i,2)
end if
if (idir == 2) then
if (n == 2) then
pm(3) = ncells
jl = nb
ju = ne
else
jl = nlims(pm(2),1)
ju = nlims(pm(2),2)
pm(3) = nghosts
jl = nlims(j,1)
ju = nlims(j,2)
end if
#if NDIMS == 3
if (idir == 3) then
if (k == 3) then
pm(4) = ncells
kl = nb
ku = ne
else
kl = nlims(pm(3),1)
ku = nlims(pm(3),2)
pm(4) = nghosts
kl = nlims(k,1)
ku = nlims(k,2)
end if
#endif /* NDIMS == 3 */
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(:,:,:,:,l)
pdata%q(:,il:iu,jl:ju,kl:ku) = reshape(rbuf(:,l), pm)
pinfo => pinfo%prev
end do