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

BOUNDARIES: Rewrite prolong_boundaries().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2014-01-07 12:26:21 -02:00
parent da136a832e
commit df72d256eb
1 changed files with 205 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

281
src/boundaries.F90
View File

@ -2102,22 +2102,19 @@ module boundaries
! subroutine PROLONG_BOUNDARIES:
! -----------------------------
!
! Subroutine scans over all leaf blocks in order to find neighbours at
! different levels, then updates the boundaries of blocks at higher level by
! prolongating variables from lower level blocks.
! Subroutine scans over all leaf blocks and updates the variable boundaries
! from neighbor blocks laying at lower levels.
!
! Arguments:
!
! ilev - the level to be processed;
! idir - the direction to be processed;
!
!===============================================================================
!
subroutine prolong_boundaries(ilev, idir)
! include external procedures
!
#ifdef MPI
use mpitools , only : send_real_array, receive_real_array
#endif /* MPI */
! include external variables
! import external procedures and variables
!
use blocks , only : ndims, nsides, nfaces
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 : ib, jb, kb, ie, je, ke
use coordinates , only : ibu, jbu, kbu, iel, jel, kel
use mpitools , only : periodic
#ifdef MPI
use mpitools , only : nproc, nprocs, npmax
use equations , only : nv
use mpitools , only : nproc, nprocs, npmax
use mpitools , only : send_real_array, receive_real_array
#endif /* MPI */
! local variables are not implicit by default
@ -2140,6 +2137,14 @@ module boundaries
!
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
!
integer :: iside, iface, nside, nface
@ -2148,20 +2153,15 @@ module boundaries
#ifdef MPI
integer :: isend, irecv, nblocks, itag, l
! local pointer arrays
!
type(pointer_info), dimension(0:npmax,0:npmax) :: block_array
! local arrays
!
integer , dimension(0:npmax,0:npmax) :: block_counter
real(kind=8), dimension(:,:,:,:,:), allocatable :: rbuf
#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 */
#ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
! reset the exchange block counters
!
block_counter(:,:) = 0
@ -2185,24 +2187,28 @@ module boundaries
end do
#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
! scan all meta blocks and process blocks at the current level
! iterate over all meta blocks
!
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 iface = 1, nfaces
! assign a pointer to the neighbor
! assign a pointer to the current neighbor
!
pneigh => pmeta%neigh(idir,iside,iface)%ptr
@ -2210,34 +2216,34 @@ module boundaries
!
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
!
if (iface .eq. 1) then
if (iface == 1) then
#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 */
! 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
nface = 1
do while(pmeta%id .ne. &
do while(pmeta%id /= &
pneigh%neigh(idir,nside,nface)%ptr%id)
nface = nface + 1
end do
! prepare indices of the neighbor array
! prepare indices of the neighbor slices used for the boundary update
!
il = 1
iu = im
@ -2248,7 +2254,7 @@ module boundaries
select case(idir)
case(1)
if (iside .eq. 1) then
if (iside == 1) then
il = ie - nh
iu = ie + 1
else
@ -2256,7 +2262,7 @@ module boundaries
iu = ib + nh
end if
case(2)
if (iside .eq. 1) then
if (iside == 1) then
jl = je - nh
ju = je + 1
else
@ -2264,7 +2270,7 @@ module boundaries
ju = jb + nh
end if
case(3)
if (iside .eq. 1) then
if (iside == 1) then
kl = ke - nh
ku = ke + 1
else
@ -2273,22 +2279,22 @@ module boundaries
end if
end select
! assign a pointer to the data structure of the current block
! assign a pointer to the associated data block
!
pdata => pmeta%data
! update the boundaries of the current block
! update boundaries of the current block from its neighbor
!
call boundary_prolong(pdata &
, pneigh%data%u(:,il:iu,jl:ju,kl:ku) &
, idir, iside, nface)
#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) + 1
@ -2311,30 +2317,28 @@ module boundaries
nullify(pinfo%prev)
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
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
end if ! block and neighbor on different processors
end if ! block and neighbor belong to different processes
#endif /* MPI */
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 ! sides
end if ! leaf
end if ! leaf at level ilev
! associate the pointer with the next meta block
!
@ -2343,14 +2347,16 @@ module boundaries
end do ! meta blocks
#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 isend = 0, nprocs - 1
do irecv = 0, npmax
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
!
@ -2360,7 +2366,7 @@ module boundaries
!
itag = 10 * (irecv * nprocs + isend + 1) + 3
! allocate space for variables
! allocate data buffer for block variable exchange
!
select case(idir)
case(1)
@ -2373,20 +2379,34 @@ module boundaries
! 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
do while(associated(pinfo))
! prepare indices of the neighbor array
! process each direction separately
!
select case(idir)
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
iu = ie + 1
else
@ -2394,10 +2414,34 @@ module boundaries
iu = ib + nh
end if
! fill the data buffer with the current block variable slices
!
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)
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
ju = je + 1
else
@ -2405,10 +2449,35 @@ module boundaries
ju = jb + nh
end if
! fill the data buffer with the current block variable slices
!
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)
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
ku = ke + 1
else
@ -2416,35 +2485,52 @@ module boundaries
ku = kb + nh
end if
! fill the data buffer with the current block variable slices
!
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
pinfo => pinfo%prev
l = l + 1
end do
! send data buffer
! send the data buffer to another process
!
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 .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
! iterate over all received blocks and update boundaries of the corresponding
! data blocks
!
do while(associated(pinfo))
! set indices
! increase the block counter
!
l = l + 1
! set side and face indices
!
iside = pinfo%side
iface = pinfo%face
@ -2455,11 +2541,11 @@ module boundaries
pdata => pinfo%block%data
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
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
end do
@ -2468,31 +2554,46 @@ module boundaries
call boundary_prolong(pdata, rbuf(l,:,:,:,:) &
, idir, iside, nface)
! associate the pointer with the next block
!
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)
! deallocate info blocks
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(irecv,isend)%ptr
! iterate over all objects on the exchange list
!
do while(associated(pinfo))
! associate the exchange list pointer
!
block_array(irecv,isend)%ptr => pinfo%prev
! nullify the pointer fields
!
nullify(pinfo%prev)
nullify(pinfo%next)
nullify(pinfo%block)
nullify(pinfo%neigh)
! deallocate the object
!
deallocate(pinfo)
! associate the pointer with the next block
!
pinfo => block_array(irecv,isend)%ptr
end do
end do ! %ptr block list
end if ! if block_count > 0