BOUNDARIES: Rewrite prolong_boundaries().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
da136a832e
commit
df72d256eb
@ -2102,22 +2102,19 @@ module boundaries
|
|||||||
! subroutine PROLONG_BOUNDARIES:
|
! subroutine PROLONG_BOUNDARIES:
|
||||||
! -----------------------------
|
! -----------------------------
|
||||||
!
|
!
|
||||||
! Subroutine scans over all leaf blocks in order to find neighbours at
|
! Subroutine scans over all leaf blocks and updates the variable boundaries
|
||||||
! different levels, then updates the boundaries of blocks at higher level by
|
! from neighbor blocks laying at lower levels.
|
||||||
! prolongating variables from lower level blocks.
|
|
||||||
!
|
!
|
||||||
|
! Arguments:
|
||||||
|
!
|
||||||
|
! ilev - the level to be processed;
|
||||||
|
! idir - the direction to be processed;
|
||||||
!
|
!
|
||||||
!===============================================================================
|
!===============================================================================
|
||||||
!
|
!
|
||||||
subroutine prolong_boundaries(ilev, idir)
|
subroutine prolong_boundaries(ilev, idir)
|
||||||
|
|
||||||
! include external procedures
|
! import external procedures and variables
|
||||||
!
|
|
||||||
#ifdef MPI
|
|
||||||
use mpitools , only : send_real_array, receive_real_array
|
|
||||||
#endif /* MPI */
|
|
||||||
|
|
||||||
! include external variables
|
|
||||||
!
|
!
|
||||||
use blocks , only : ndims, nsides, nfaces
|
use blocks , only : ndims, nsides, nfaces
|
||||||
use blocks , only : block_meta, block_data, list_meta
|
use blocks , only : block_meta, block_data, list_meta
|
||||||
@ -2126,10 +2123,10 @@ module boundaries
|
|||||||
use coordinates , only : ng, nd, nh, im, jm, km
|
use coordinates , only : ng, nd, nh, im, jm, km
|
||||||
use coordinates , only : ib, jb, kb, ie, je, ke
|
use coordinates , only : ib, jb, kb, ie, je, ke
|
||||||
use coordinates , only : ibu, jbu, kbu, iel, jel, kel
|
use coordinates , only : ibu, jbu, kbu, iel, jel, kel
|
||||||
use mpitools , only : periodic
|
|
||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
use mpitools , only : nproc, nprocs, npmax
|
|
||||||
use equations , only : nv
|
use equations , only : nv
|
||||||
|
use mpitools , only : nproc, nprocs, npmax
|
||||||
|
use mpitools , only : send_real_array, receive_real_array
|
||||||
#endif /* MPI */
|
#endif /* MPI */
|
||||||
|
|
||||||
! local variables are not implicit by default
|
! local variables are not implicit by default
|
||||||
@ -2140,6 +2137,14 @@ module boundaries
|
|||||||
!
|
!
|
||||||
integer, intent(in) :: ilev, idir
|
integer, intent(in) :: ilev, idir
|
||||||
|
|
||||||
|
! local pointers
|
||||||
|
!
|
||||||
|
type(block_meta), pointer :: pmeta, pneigh
|
||||||
|
type(block_data), pointer :: pdata
|
||||||
|
#ifdef MPI
|
||||||
|
type(block_info), pointer :: pinfo
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
! local variables
|
! local variables
|
||||||
!
|
!
|
||||||
integer :: iside, iface, nside, nface
|
integer :: iside, iface, nside, nface
|
||||||
@ -2148,20 +2153,15 @@ module boundaries
|
|||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
integer :: isend, irecv, nblocks, itag, l
|
integer :: isend, irecv, nblocks, itag, l
|
||||||
|
|
||||||
|
! local pointer arrays
|
||||||
|
!
|
||||||
|
type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
|
||||||
|
|
||||||
! local arrays
|
! local arrays
|
||||||
!
|
!
|
||||||
integer , dimension(0:npmax,0:npmax) :: block_counter
|
integer , dimension(0:npmax,0:npmax) :: block_counter
|
||||||
real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
|
real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
|
||||||
#endif /* MPI */
|
#endif /* MPI */
|
||||||
|
|
||||||
! local pointers
|
|
||||||
!
|
|
||||||
type(block_meta), pointer :: pmeta, pneigh
|
|
||||||
type(block_data), pointer :: pdata
|
|
||||||
#ifdef MPI
|
|
||||||
type(block_info), pointer :: pinfo
|
|
||||||
type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
|
|
||||||
#endif /* MPI */
|
|
||||||
!
|
!
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
@ -2172,6 +2172,8 @@ module boundaries
|
|||||||
#endif /* PROFILE */
|
#endif /* PROFILE */
|
||||||
|
|
||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
|
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
|
||||||
|
!!
|
||||||
! reset the exchange block counters
|
! reset the exchange block counters
|
||||||
!
|
!
|
||||||
block_counter(:,:) = 0
|
block_counter(:,:) = 0
|
||||||
@ -2185,24 +2187,28 @@ module boundaries
|
|||||||
end do
|
end do
|
||||||
#endif /* MPI */
|
#endif /* MPI */
|
||||||
|
|
||||||
! assign the pointer with the first block on in the list
|
!! 2. UPDATE VARIABLE BOUNDARIES BETWEEN BLOCKS BELONGING TO THE SAME PROCESS
|
||||||
|
!! AND PREPARE THE EXCHANGE BLOCK LIST OF BLOCKS WHICH BELONG TO
|
||||||
|
!! DIFFERENT PROCESSES
|
||||||
|
!!
|
||||||
|
! assign the pointer to the first block on the meta block list
|
||||||
!
|
!
|
||||||
pmeta => list_meta
|
pmeta => list_meta
|
||||||
|
|
||||||
! scan all meta blocks and process blocks at the current level
|
! iterate over all meta blocks
|
||||||
!
|
!
|
||||||
do while(associated(pmeta))
|
do while(associated(pmeta))
|
||||||
|
|
||||||
! check if the block is a leaf at the current level
|
! check if the block is the leaf at level ilev
|
||||||
!
|
!
|
||||||
if (pmeta%leaf .and. pmeta%level .eq. ilev) then
|
if (pmeta%leaf .and. pmeta%level == ilev) then
|
||||||
|
|
||||||
! scan over sides and faces
|
! iterate over sides and faces
|
||||||
!
|
!
|
||||||
do iside = 1, nsides
|
do iside = 1, nsides
|
||||||
do iface = 1, nfaces
|
do iface = 1, nfaces
|
||||||
|
|
||||||
! assign a pointer to the neighbor
|
! assign a pointer to the current neighbor
|
||||||
!
|
!
|
||||||
pneigh => pmeta%neigh(idir,iside,iface)%ptr
|
pneigh => pmeta%neigh(idir,iside,iface)%ptr
|
||||||
|
|
||||||
@ -2210,34 +2216,34 @@ module boundaries
|
|||||||
!
|
!
|
||||||
if (associated(pneigh)) then
|
if (associated(pneigh)) then
|
||||||
|
|
||||||
! check if the neighbor is at lower level
|
! check if the neighbor lays at lower level
|
||||||
!
|
!
|
||||||
if (pneigh%level .lt. pmeta%level) then
|
if (pneigh%level < pmeta%level) then
|
||||||
|
|
||||||
! perform update only for the first face, since all faces point the same block
|
! perform update only for the first face, since all faces point the same block
|
||||||
!
|
!
|
||||||
if (iface .eq. 1) then
|
if (iface == 1) then
|
||||||
|
|
||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
! check if the current meta block and its neighbor lay on the same processor
|
! check if the current meta block and its neighbor belong to the same process
|
||||||
!
|
!
|
||||||
if (pmeta%cpu .eq. pneigh%cpu) then
|
if (pmeta%cpu == pneigh%cpu) then
|
||||||
|
|
||||||
! check if the current meta block lays on the current processors
|
! check if the current meta block belong to the current process
|
||||||
!
|
!
|
||||||
if (pmeta%cpu .eq. nproc) then
|
if (pmeta%cpu == nproc) then
|
||||||
#endif /* MPI */
|
#endif /* MPI */
|
||||||
|
|
||||||
! find the face of the current block which the neighbor belongs to
|
! find the neighbor side and face pointing to the current block
|
||||||
!
|
!
|
||||||
nside = 3 - iside
|
nside = 3 - iside
|
||||||
nface = 1
|
nface = 1
|
||||||
do while(pmeta%id .ne. &
|
do while(pmeta%id /= &
|
||||||
pneigh%neigh(idir,nside,nface)%ptr%id)
|
pneigh%neigh(idir,nside,nface)%ptr%id)
|
||||||
nface = nface + 1
|
nface = nface + 1
|
||||||
end do
|
end do
|
||||||
|
|
||||||
! prepare indices of the neighbor array
|
! prepare indices of the neighbor slices used for the boundary update
|
||||||
!
|
!
|
||||||
il = 1
|
il = 1
|
||||||
iu = im
|
iu = im
|
||||||
@ -2248,7 +2254,7 @@ module boundaries
|
|||||||
|
|
||||||
select case(idir)
|
select case(idir)
|
||||||
case(1)
|
case(1)
|
||||||
if (iside .eq. 1) then
|
if (iside == 1) then
|
||||||
il = ie - nh
|
il = ie - nh
|
||||||
iu = ie + 1
|
iu = ie + 1
|
||||||
else
|
else
|
||||||
@ -2256,7 +2262,7 @@ module boundaries
|
|||||||
iu = ib + nh
|
iu = ib + nh
|
||||||
end if
|
end if
|
||||||
case(2)
|
case(2)
|
||||||
if (iside .eq. 1) then
|
if (iside == 1) then
|
||||||
jl = je - nh
|
jl = je - nh
|
||||||
ju = je + 1
|
ju = je + 1
|
||||||
else
|
else
|
||||||
@ -2264,7 +2270,7 @@ module boundaries
|
|||||||
ju = jb + nh
|
ju = jb + nh
|
||||||
end if
|
end if
|
||||||
case(3)
|
case(3)
|
||||||
if (iside .eq. 1) then
|
if (iside == 1) then
|
||||||
kl = ke - nh
|
kl = ke - nh
|
||||||
ku = ke + 1
|
ku = ke + 1
|
||||||
else
|
else
|
||||||
@ -2273,22 +2279,22 @@ module boundaries
|
|||||||
end if
|
end if
|
||||||
end select
|
end select
|
||||||
|
|
||||||
! assign a pointer to the data structure of the current block
|
! assign a pointer to the associated data block
|
||||||
!
|
!
|
||||||
pdata => pmeta%data
|
pdata => pmeta%data
|
||||||
|
|
||||||
! update the boundaries of the current block
|
! update boundaries of the current block from its neighbor
|
||||||
!
|
!
|
||||||
call boundary_prolong(pdata &
|
call boundary_prolong(pdata &
|
||||||
, pneigh%data%u(:,il:iu,jl:ju,kl:ku) &
|
, pneigh%data%u(:,il:iu,jl:ju,kl:ku) &
|
||||||
, idir, iside, nface)
|
, idir, iside, nface)
|
||||||
|
|
||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
end if ! pmeta on the current cpu
|
end if ! pmeta on the current process
|
||||||
|
|
||||||
else ! block and neighbor on different processors
|
else ! block and neighbor belong to different processes
|
||||||
|
|
||||||
! increase the counter for number of blocks to exchange
|
! increase the counter for the number of blocks to exchange
|
||||||
!
|
!
|
||||||
block_counter(pmeta%cpu,pneigh%cpu) = &
|
block_counter(pmeta%cpu,pneigh%cpu) = &
|
||||||
block_counter(pmeta%cpu,pneigh%cpu) + 1
|
block_counter(pmeta%cpu,pneigh%cpu) + 1
|
||||||
@ -2311,30 +2317,28 @@ module boundaries
|
|||||||
nullify(pinfo%prev)
|
nullify(pinfo%prev)
|
||||||
nullify(pinfo%next)
|
nullify(pinfo%next)
|
||||||
|
|
||||||
! if the list is not empty append the created block
|
! if the list is not empty append the newly created info object to it
|
||||||
!
|
!
|
||||||
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) then
|
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) &
|
||||||
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr
|
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr
|
||||||
nullify(pinfo%next)
|
|
||||||
end if
|
|
||||||
|
|
||||||
! point the list to the last created block
|
! point the list to the newly created info object
|
||||||
!
|
!
|
||||||
block_array(pmeta%cpu,pneigh%cpu)%ptr => pinfo
|
block_array(pmeta%cpu,pneigh%cpu)%ptr => pinfo
|
||||||
|
|
||||||
end if ! block and neighbor on different processors
|
end if ! block and neighbor belong to different processes
|
||||||
#endif /* MPI */
|
#endif /* MPI */
|
||||||
|
|
||||||
end if ! iface = 1
|
end if ! iface = 1
|
||||||
|
|
||||||
end if ! neighbor at lower level
|
end if ! neighbor belongs to lower level
|
||||||
|
|
||||||
end if ! neighbor associated
|
end if ! neighbor is associated
|
||||||
|
|
||||||
end do ! faces
|
end do ! faces
|
||||||
end do ! sides
|
end do ! sides
|
||||||
|
|
||||||
end if ! leaf
|
end if ! leaf at level ilev
|
||||||
|
|
||||||
! associate the pointer with the next meta block
|
! associate the pointer with the next meta block
|
||||||
!
|
!
|
||||||
@ -2343,14 +2347,16 @@ module boundaries
|
|||||||
end do ! meta blocks
|
end do ! meta blocks
|
||||||
|
|
||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
! iterate over sending and receiving processors
|
!! 3. UPDATE VARIABLE BOUNDARIES BETWEEN BLOCKS BELONGING TO DIFFERENT PROCESSES
|
||||||
|
!!
|
||||||
|
! iterate over sending and receiving processes
|
||||||
!
|
!
|
||||||
do irecv = 0, nprocs - 1
|
do irecv = 0, npmax
|
||||||
do isend = 0, nprocs - 1
|
do isend = 0, npmax
|
||||||
|
|
||||||
! process only pairs which have boundaries to exchange
|
! process only pairs which have anything to exchange
|
||||||
!
|
!
|
||||||
if (block_counter(irecv,isend) .gt. 0) then
|
if (block_counter(irecv,isend) > 0) then
|
||||||
|
|
||||||
! obtain the number of blocks to exchange
|
! obtain the number of blocks to exchange
|
||||||
!
|
!
|
||||||
@ -2360,7 +2366,7 @@ module boundaries
|
|||||||
!
|
!
|
||||||
itag = 10 * (irecv * nprocs + isend + 1) + 3
|
itag = 10 * (irecv * nprocs + isend + 1) + 3
|
||||||
|
|
||||||
! allocate space for variables
|
! allocate data buffer for block variable exchange
|
||||||
!
|
!
|
||||||
select case(idir)
|
select case(idir)
|
||||||
case(1)
|
case(1)
|
||||||
@ -2373,20 +2379,34 @@ module boundaries
|
|||||||
|
|
||||||
! if isend == nproc we are sending data
|
! if isend == nproc we are sending data
|
||||||
!
|
!
|
||||||
if (isend .eq. nproc) then
|
if (isend == nproc) then
|
||||||
|
|
||||||
! fill out the buffer with block data
|
! reset the block counter
|
||||||
!
|
!
|
||||||
l = 1
|
l = 0
|
||||||
|
|
||||||
pinfo => block_array(irecv,isend)%ptr
|
! process each direction separately
|
||||||
do while(associated(pinfo))
|
|
||||||
|
|
||||||
! prepare indices of the neighbor array
|
|
||||||
!
|
!
|
||||||
select case(idir)
|
select case(idir)
|
||||||
|
|
||||||
case(1)
|
case(1)
|
||||||
if (pinfo%side .eq. 1) then
|
|
||||||
|
! associate the pointer with the first block in the exchange list
|
||||||
|
!
|
||||||
|
pinfo => block_array(irecv,isend)%ptr
|
||||||
|
|
||||||
|
! iterate over exchange blocks and fill out the data buffer with the block
|
||||||
|
! variables
|
||||||
|
!
|
||||||
|
do while(associated(pinfo))
|
||||||
|
|
||||||
|
! increase the block counter
|
||||||
|
!
|
||||||
|
l = l + 1
|
||||||
|
|
||||||
|
! prepare slice indices depending on the side
|
||||||
|
!
|
||||||
|
if (pinfo%side == 1) then
|
||||||
il = ie - nh
|
il = ie - nh
|
||||||
iu = ie + 1
|
iu = ie + 1
|
||||||
else
|
else
|
||||||
@ -2394,10 +2414,34 @@ module boundaries
|
|||||||
iu = ib + nh
|
iu = ib + nh
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
! fill the data buffer with the current block variable slices
|
||||||
|
!
|
||||||
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,il:iu,:,:)
|
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,il:iu,:,:)
|
||||||
|
|
||||||
|
! associate the pointer with the next block
|
||||||
|
!
|
||||||
|
pinfo => pinfo%prev
|
||||||
|
|
||||||
|
end do ! %ptr block list
|
||||||
|
|
||||||
case(2)
|
case(2)
|
||||||
if (pinfo%side .eq. 1) then
|
|
||||||
|
! associate the pointer with the first block in the exchange list
|
||||||
|
!
|
||||||
|
pinfo => block_array(irecv,isend)%ptr
|
||||||
|
|
||||||
|
! iterate over exchange blocks and fill out the data buffer with the block
|
||||||
|
! variables
|
||||||
|
!
|
||||||
|
do while(associated(pinfo))
|
||||||
|
|
||||||
|
! increase the block counter
|
||||||
|
!
|
||||||
|
l = l + 1
|
||||||
|
|
||||||
|
! prepare slice indices depending on the side
|
||||||
|
!
|
||||||
|
if (pinfo%side == 1) then
|
||||||
jl = je - nh
|
jl = je - nh
|
||||||
ju = je + 1
|
ju = je + 1
|
||||||
else
|
else
|
||||||
@ -2405,10 +2449,35 @@ module boundaries
|
|||||||
ju = jb + nh
|
ju = jb + nh
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
! fill the data buffer with the current block variable slices
|
||||||
|
!
|
||||||
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,jl:ju,:)
|
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,jl:ju,:)
|
||||||
|
|
||||||
|
! associate the pointer with the next block
|
||||||
|
!
|
||||||
|
pinfo => pinfo%prev
|
||||||
|
|
||||||
|
end do ! %ptr block list
|
||||||
|
|
||||||
|
#if NDIMS == 3
|
||||||
case(3)
|
case(3)
|
||||||
if (pinfo%side .eq. 1) then
|
|
||||||
|
! associate the pointer with the first block in the exchange list
|
||||||
|
!
|
||||||
|
pinfo => block_array(irecv,isend)%ptr
|
||||||
|
|
||||||
|
! iterate over exchange blocks and fill out the data buffer with the block
|
||||||
|
! variables
|
||||||
|
!
|
||||||
|
do while(associated(pinfo))
|
||||||
|
|
||||||
|
! increase the block counter
|
||||||
|
!
|
||||||
|
l = l + 1
|
||||||
|
|
||||||
|
! prepare slice indices depending on the side
|
||||||
|
!
|
||||||
|
if (pinfo%side == 1) then
|
||||||
kl = ke - nh
|
kl = ke - nh
|
||||||
ku = ke + 1
|
ku = ke + 1
|
||||||
else
|
else
|
||||||
@ -2416,35 +2485,52 @@ module boundaries
|
|||||||
ku = kb + nh
|
ku = kb + nh
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
! fill the data buffer with the current block variable slices
|
||||||
|
!
|
||||||
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,:,kl:ku)
|
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,:,kl:ku)
|
||||||
|
|
||||||
|
! associate the pointer with the next block
|
||||||
|
!
|
||||||
|
pinfo => pinfo%prev
|
||||||
|
|
||||||
|
end do ! %ptr block list
|
||||||
|
#endif /* NDIMS == 3 */
|
||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
pinfo => pinfo%prev
|
! send the data buffer to another process
|
||||||
l = l + 1
|
|
||||||
end do
|
|
||||||
|
|
||||||
! send data buffer
|
|
||||||
!
|
!
|
||||||
call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
|
call send_real_array(size(rbuf), irecv, itag, rbuf(:,:,:,:,:), iret)
|
||||||
|
|
||||||
end if
|
end if ! irecv = nproc
|
||||||
|
|
||||||
! if irecv == nproc we are receiving data
|
! if irecv == nproc we are receiving data
|
||||||
!
|
!
|
||||||
if (irecv .eq. nproc) then
|
if (irecv == nproc) then
|
||||||
|
|
||||||
! receive data
|
! receive the data buffer
|
||||||
!
|
!
|
||||||
call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag, rbuf(:,:,:,:,:), iret)
|
call receive_real_array(size(rbuf(:,:,:,:,:)), isend, itag &
|
||||||
|
, rbuf(:,:,:,:,:), iret)
|
||||||
|
|
||||||
! iterate over all received blocks and update boundaries
|
! reset the block counter
|
||||||
!
|
!
|
||||||
l = 1
|
l = 0
|
||||||
|
|
||||||
|
! associate the pointer with the first block in the exchange list
|
||||||
|
!
|
||||||
pinfo => block_array(irecv,isend)%ptr
|
pinfo => block_array(irecv,isend)%ptr
|
||||||
|
|
||||||
|
! iterate over all received blocks and update boundaries of the corresponding
|
||||||
|
! data blocks
|
||||||
|
!
|
||||||
do while(associated(pinfo))
|
do while(associated(pinfo))
|
||||||
|
|
||||||
! set indices
|
! increase the block counter
|
||||||
|
!
|
||||||
|
l = l + 1
|
||||||
|
|
||||||
|
! set side and face indices
|
||||||
!
|
!
|
||||||
iside = pinfo%side
|
iside = pinfo%side
|
||||||
iface = pinfo%face
|
iface = pinfo%face
|
||||||
@ -2455,11 +2541,11 @@ module boundaries
|
|||||||
pdata => pinfo%block%data
|
pdata => pinfo%block%data
|
||||||
pneigh => pmeta%neigh(idir,iside,iface)%ptr
|
pneigh => pmeta%neigh(idir,iside,iface)%ptr
|
||||||
|
|
||||||
! find the face of the current block which the neighbor belongs to
|
! find the neighbor side and face pointing to the current block
|
||||||
!
|
!
|
||||||
nside = 3 - iside
|
nside = 3 - iside
|
||||||
nface = 1
|
nface = 1
|
||||||
do while(pmeta%id .ne. pneigh%neigh(idir,nside,nface)%ptr%id)
|
do while(pmeta%id /= pneigh%neigh(idir,nside,nface)%ptr%id)
|
||||||
nface = nface + 1
|
nface = nface + 1
|
||||||
end do
|
end do
|
||||||
|
|
||||||
@ -2468,31 +2554,46 @@ module boundaries
|
|||||||
call boundary_prolong(pdata, rbuf(l,:,:,:,:) &
|
call boundary_prolong(pdata, rbuf(l,:,:,:,:) &
|
||||||
, idir, iside, nface)
|
, idir, iside, nface)
|
||||||
|
|
||||||
|
! associate the pointer with the next block
|
||||||
|
!
|
||||||
pinfo => pinfo%prev
|
pinfo => pinfo%prev
|
||||||
l = l + 1
|
|
||||||
end do
|
|
||||||
|
|
||||||
end if
|
end do ! %ptr block list
|
||||||
|
|
||||||
! deallocate buffers
|
end if ! irecv = nproc
|
||||||
|
|
||||||
|
! deallocate the data buffer
|
||||||
!
|
!
|
||||||
if (allocated(rbuf)) deallocate(rbuf)
|
if (allocated(rbuf)) deallocate(rbuf)
|
||||||
|
|
||||||
! deallocate info blocks
|
! associate the pointer with the first block in the exchange list
|
||||||
!
|
!
|
||||||
pinfo => block_array(irecv,isend)%ptr
|
pinfo => block_array(irecv,isend)%ptr
|
||||||
|
|
||||||
|
! iterate over all objects on the exchange list
|
||||||
|
!
|
||||||
do while(associated(pinfo))
|
do while(associated(pinfo))
|
||||||
|
|
||||||
|
! associate the exchange list pointer
|
||||||
|
!
|
||||||
block_array(irecv,isend)%ptr => pinfo%prev
|
block_array(irecv,isend)%ptr => pinfo%prev
|
||||||
|
|
||||||
|
! nullify the pointer fields
|
||||||
|
!
|
||||||
nullify(pinfo%prev)
|
nullify(pinfo%prev)
|
||||||
nullify(pinfo%next)
|
nullify(pinfo%next)
|
||||||
nullify(pinfo%block)
|
nullify(pinfo%block)
|
||||||
nullify(pinfo%neigh)
|
nullify(pinfo%neigh)
|
||||||
|
|
||||||
|
! deallocate the object
|
||||||
|
!
|
||||||
deallocate(pinfo)
|
deallocate(pinfo)
|
||||||
|
|
||||||
|
! associate the pointer with the next block
|
||||||
|
!
|
||||||
pinfo => block_array(irecv,isend)%ptr
|
pinfo => block_array(irecv,isend)%ptr
|
||||||
end do
|
|
||||||
|
end do ! %ptr block list
|
||||||
|
|
||||||
end if ! if block_count > 0
|
end if ! if block_count > 0
|
||||||
|
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user