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

309
src/boundaries.F90
View File

@ -2102,34 +2102,31 @@ 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
! !
use blocks , only : ndims, nsides, nfaces
use blocks , only : block_meta, block_data, list_meta
use blocks , only : block_info, pointer_info
use coordinates , only : toplev
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
#ifdef MPI #ifdef MPI
use mpitools , only : send_real_array, receive_real_array use equations , only : nv
#endif /* MPI */ use mpitools , only : nproc, nprocs, npmax
use mpitools , only : send_real_array, receive_real_array
! include external variables
!
use blocks , only : ndims, nsides, nfaces
use blocks , only : block_meta, block_data, list_meta
use blocks , only : block_info, pointer_info
use coordinates , only : toplev
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
#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)
if (pinfo%side .eq. 1) then case(1)
! 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,:,:)
case(2) ! associate the pointer with the next block
if (pinfo%side .eq. 1) then !
pinfo => pinfo%prev
end do ! %ptr block list
case(2)
! 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,:)
case(3) ! associate the pointer with the next block
if (pinfo%side .eq. 1) then !
pinfo => pinfo%prev
end do ! %ptr block list
#if NDIMS == 3
case(3)
! 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)
end select
pinfo => pinfo%prev ! associate the pointer with the next block
l = l + 1 !
end do pinfo => pinfo%prev
! send data buffer end do ! %ptr block list
#endif /* NDIMS == 3 */
end select
! send the data buffer to another process
! !
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