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

BOUNDARIES: Rewrite boundaries_corner_prolong().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2022-02-03 15:37:02 -03:00
parent 8379192543
commit 09619fc7c8
1 changed files with 104 additions and 222 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

326
sources/boundaries.F90
View File

@ -4386,63 +4386,70 @@ module boundaries
!
! Subroutine updates the corner boundaries from blocks on lower level.
!
! Arguments:
!
! status - the call status;
!
!===============================================================================
!
subroutine boundaries_corner_prolong(status)
! import external procedures and variables
!
use blocks , only : nsides
use blocks , only : block_meta, block_data, block_leaf
use blocks , only : list_leaf
use blocks , only : block_info, pointer_info
#ifdef MPI
use coordinates, only : ng => nghosts
#endif /* MPI */
use coordinates, only : corners_gp
use coordinates, only : nn => bcells, ng => nghosts
use equations , only : nv
use helpers , only : print_message
#ifdef MPI
use mpitools , only : nproc, npairs, pairs
use mpitools , only : exchange_arrays
#endif /* MPI */
! local variables are not implicit by default
!
implicit none
integer, intent(out) :: status
! local pointers
!
type(block_meta), pointer :: pmeta, pneigh
type(block_data), pointer :: pdata
type(block_leaf), pointer :: pleaf
#ifdef MPI
type(block_info), pointer :: pinfo
#endif /* MPI */
! local variables
!
integer :: i, il, iu
integer :: j, jl, ju
integer :: k
#if NDIMS == 3
integer :: kl, ku
#endif /* NDIMS == 3 */
integer :: k, kl, ku
#ifdef MPI
integer :: sproc, rproc
integer :: scount, rcount
integer :: l, p
! local arrays
!
real(kind=8), dimension(:,:,:,:,:), allocatable :: sbuf, rbuf
#endif /* MPI */
!
logical , save :: first = .true.
integer, dimension(2,2), save :: nlims
character(len=*), parameter :: loc = &
'BOUNDARIES::boundaries_corner_prolong()'
!-------------------------------------------------------------------------------
!
if (first) then
nlims(1,1) = 1
nlims(1,2) = ng
nlims(2,1) = nn - ng + 1
nlims(2,2) = nn
first = .false.
end if
#if NDIMS == 2
k = 1
k = 1
kl = 1
ku = 1
#endif /* NDIMS == 2 */
#ifdef MPI
@ -4451,35 +4458,28 @@ module boundaries
scount = 0
rcount = 0
! prepare the block exchange structures
!
call prepare_exchange_array()
#endif /* MPI */
! update boundaries between blocks on the same process
!
! associate pleaf with the first block on the leaf list
!
pleaf => list_leaf
! scan all leaf meta blocks in the list
!
do while(associated(pleaf))
! get the associated meta block
!
pmeta => pleaf%meta
pdata => pmeta%data
! scan over all block corners
!
#if NDIMS == 3
do k = 1, nsides
kl = nlims(k,1)
ku = nlims(k,2)
#endif /* NDIMS == 3 */
do j = 1, nsides
jl = nlims(j,1)
ju = nlims(j,2)
do i = 1, nsides
il = nlims(i,1)
iu = nlims(i,2)
! assign pneigh to the current neighbor
!
#if NDIMS == 2
pneigh => pmeta%corners(i,j)%ptr
#endif /* NDIMS == 2 */
@ -4487,101 +4487,53 @@ module boundaries
pneigh => pmeta%corners(i,j,k)%ptr
#endif /* NDIMS == 3 */
! check if the neighbor is associated
!
if (associated(pneigh)) then
! check if the neighbor lays at lower level
!
if (pneigh%level < pmeta%level) then
! skip if the block and its neighbor are not marked for update
!
if (pmeta%update .or. pneigh%update) then
#ifdef MPI
! check if the block and its neighbor belong to the same process
!
if (pmeta%process == pneigh%process) then
! check if the neighbor belongs to the current process
!
if (pneigh%process == nproc) then
#endif /* MPI */
! prepare the region indices for corner boundary update
!
#if NDIMS == 2
il = corners_gp(i,j )%l(1)
jl = corners_gp(i,j )%l(2)
iu = corners_gp(i,j )%u(1)
ju = corners_gp(i,j )%u(2)
#endif /* NDIMS == 2 */
#if NDIMS == 3
il = corners_gp(i,j,k)%l(1)
jl = corners_gp(i,j,k)%l(2)
kl = corners_gp(i,j,k)%l(3)
iu = corners_gp(i,j,k)%u(1)
ju = corners_gp(i,j,k)%u(2)
ku = corners_gp(i,j,k)%u(3)
#endif /* NDIMS == 3 */
! restrict and extract the corresponding corner region from the neighbor and
! insert it in the current data block
!
#if NDIMS == 2
call block_corner_prolong((/ i, j, k /) &
, pneigh%data%q(1:nv, : , : , : ) &
, pmeta%data%q(1:nv,il:iu,jl:ju, : ), status)
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_corner_prolong((/ i, j, k /) &
, pneigh%data%q(1:nv, : , : , : ) &
, pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku), status)
#endif /* NDIMS == 3 */
call block_corner_prolong([ i, j, k ], pneigh%data%q, &
pdata%q(:,il:iu,jl:ju,kl:ku), status)
if (status /= 0) &
call print_message(loc, &
"Block's corner prolongation failed!")
#ifdef MPI
end if ! block on the current processor
end if
else ! block and neighbor on different processors
else
! append the block to the exchange list
!
call append_exchange_block(pmeta, pneigh, -1, (/ i, j, k /))
call append_exchange_block(pmeta, pneigh, -1, [ i, j, k ])
end if ! block and neighbor on different processors
end if
#endif /* MPI */
end if ! pmeta and pneigh marked for update
end if
end if ! neighbor at lower level
end if
end if ! neighbor associated
end if
end do ! i = 1, nsides
end do ! j = 1, nsides
end do
end do
#if NDIMS == 3
end do ! k = 1, nsides
end do
#endif /* NDIMS == 3 */
! associate pleaf with the next leaf on the list
!
pleaf => pleaf%next
end do ! over leaf blocks
end do
#ifdef MPI
!! 3. UPDATE VARIABLE BOUNDARIES BETWEEN BLOCKS BELONGING TO DIFFERENT PROCESSES
!!
! iterate over all process pairs
!
do p = 1, npairs
! process only pairs related to this process
!
if (pairs(p,1) == nproc .or. pairs(p,2) == nproc) then
! get sending and receiving process identifiers (depending on pair member)
!
if (pairs(p,1) == nproc) then
sproc = pairs(p,1)
rproc = pairs(p,2)
@ -4591,157 +4543,87 @@ module boundaries
rproc = pairs(p,1)
end if
! get the number of blocks to exchange
!
scount = bcount(sproc,rproc)
rcount = bcount(rproc,sproc)
! process only pairs which have anything to exchange
!
if ((scount + rcount) > 0) then
! allocate buffers for variable exchange
!
#if NDIMS == 2
allocate(sbuf(scount,nv,ng,ng, 1))
allocate(rbuf(rcount,nv,ng,ng, 1))
#endif /* NDIMS == 2 */
if (scount > 0 .or. rcount > 0) then
#if NDIMS == 3
allocate(sbuf(scount,nv,ng,ng,ng))
allocate(rbuf(rcount,nv,ng,ng,ng))
allocate(sbuf(nv,ng,ng,ng,scount), &
rbuf(nv,ng,ng,ng,rcount), stat=status)
#else /* NDIMS == 3 */
allocate(sbuf(nv,ng,ng, 1,scount), &
rbuf(nv,ng,ng, 1,rcount), stat=status)
#endif /* NDIMS == 3 */
if (status /= 0) &
call print_message(loc, "Could not allocate the exchange buffers!")
if (scount > 0) then
l = 0
pinfo => barray(sproc,rproc)%ptr
do while(associated(pinfo))
l = l + 1
pneigh => pinfo%neigh
i = pinfo%corner(1)
j = pinfo%corner(2)
#if NDIMS == 3
k = pinfo%corner(3)
#endif /* NDIMS == 3 */
!! PREPARE BLOCKS FOR SENDING
!!
! reset the block counter
!
l = 0
call block_corner_prolong([ i, j, k ], pneigh%data%q, &
sbuf(:,:,:,:,l), status)
! associate the pointer with the first block in the exchange list
!
pinfo => barray(sproc,rproc)%ptr
pinfo => pinfo%prev
end do
! scan over all blocks on the block exchange list
!
do while(associated(pinfo))
end if
! increase the block counter
!
l = l + 1
! assign pneigh to the associated neighbor block
!
pneigh => pinfo%neigh
! get the corner coordinates
!
i = pinfo%corner(1)
j = pinfo%corner(2)
#if NDIMS == 3
k = pinfo%corner(3)
#endif /* NDIMS == 3 */
! prolong the corresponding corner region from the neighbor and insert it in
! the buffer
!
#if NDIMS == 2
call block_corner_prolong((/ i, j, k /) &
, pneigh%data%q(1:nv, : , : , : ) &
, sbuf(l,1:nv,1:ng,1:ng, : ), status)
#endif /* NDIMS == 2 */
#if NDIMS == 3
call block_corner_prolong((/ i, j, k /) &
, pneigh%data%q(1:nv, : , : , : ) &
, sbuf(l,1:nv,1:ng,1:ng,1:ng), status)
#endif /* NDIMS == 3 */
! associate the pointer with the next block
!
pinfo => pinfo%prev
end do ! %ptr block list
!! SEND PREPARED BLOCKS AND RECEIVE NEW ONES
!!
! exchange data
!
call exchange_arrays(rproc, p, sbuf, rbuf)
!! PROCESS RECEIVED BLOCKS
!!
! reset the block counter
!
l = 0
if (rcount > 0) then
! associate the pointer with the first block in the exchange list
!
pinfo => barray(rproc,sproc)%ptr
l = 0
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
!
do while(associated(pinfo))
pinfo => barray(rproc,sproc)%ptr
! increase the block counter
!
l = l + 1
do while(associated(pinfo))
! assign a pointer to the associated data block
!
pmeta => pinfo%meta
l = l + 1
! get the corner coordinates
!
i = pinfo%corner(1)
j = pinfo%corner(2)
pdata => pinfo%meta%data
il = nlims(pinfo%corner(1),1)
iu = nlims(pinfo%corner(1),2)
jl = nlims(pinfo%corner(2),1)
ju = nlims(pinfo%corner(2),2)
#if NDIMS == 3
k = pinfo%corner(3)
kl = nlims(pinfo%corner(3),1)
ku = nlims(pinfo%corner(3),2)
#endif /* NDIMS == 3 */
! prepare the region indices for corner boundary update
!
#if NDIMS == 2
il = corners_gp(i,j )%l(1)
jl = corners_gp(i,j )%l(2)
iu = corners_gp(i,j )%u(1)
ju = corners_gp(i,j )%u(2)
#endif /* NDIMS == 2 */
#if NDIMS == 3
il = corners_gp(i,j,k)%l(1)
jl = corners_gp(i,j,k)%l(2)
kl = corners_gp(i,j,k)%l(3)
iu = corners_gp(i,j,k)%u(1)
ju = corners_gp(i,j,k)%u(2)
ku = corners_gp(i,j,k)%u(3)
#endif /* NDIMS == 3 */
pdata%q(:,il:iu,jl:ju,kl:ku) = rbuf(:,:,:,:,l)
! update the corresponding corner region of the current block
!
#if NDIMS == 2
pmeta%data%q(1:nv,il:iu,jl:ju, : ) = rbuf(l,1:nv,1:ng,1:ng, : )
#endif /* NDIMS == 2 */
#if NDIMS == 3
pmeta%data%q(1:nv,il:iu,jl:ju,kl:ku) = rbuf(l,1:nv,1:ng,1:ng,1:ng)
#endif /* NDIMS == 3 */
pinfo => pinfo%prev
end do
! associate the pointer with the next block
!
pinfo => pinfo%prev
end if
end do ! %ptr block list
deallocate(sbuf, rbuf, stat=status)
if (status /= 0) &
call print_message(loc, &
"Could not deallocate the exchange buffers!")
! deallocate data buffer
!
deallocate(sbuf, rbuf)
end if
end if ! (scount + rcount) > 0
end if ! pairs(p,1) == nproc || pairs(p,2) == nproc
end if
end do ! p = 1, npairs
! release the memory used by the array of exchange block lists
!
call release_exchange_array()
#endif /* MPI */