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

BOUNDARIES: Rewrite boundary_fluxes().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2014-01-06 21:24:16 -02:00
parent f8a8121bf2
commit 43c7a86b0b
1 changed files with 225 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

317
src/boundaries.F90
View File

@ -334,58 +334,71 @@ module boundaries
! !
!=============================================================================== !===============================================================================
! !
! boundary_fluxes: subroutine sweeps over all leaf blocks and if it ! subroutine BOUNDARY_FLUXES:
! finds that two neighbors lay at different levels, it ! --------------------------
! corrects the numerical fluxes of block at lower level !
! copying the flux from higher level neighbor ! Subroutine updates the numerical fluxes of neighors at different levels.
!
! !
!=============================================================================== !===============================================================================
! !
subroutine boundary_fluxes() subroutine boundary_fluxes()
use blocks , only : block_meta, block_data, list_meta ! import external procedures and variables
use blocks , only : nsides, nfaces !
use coordinates, only : toplev use blocks , only : block_meta, block_data, list_meta
use coordinates, only : ibl, ie, jbl, je, kbl, ke
#ifdef MPI #ifdef MPI
use blocks , only : block_info, pointer_info use blocks , only : block_info, pointer_info
use coordinates, only : im, jm, km #endif /* MPI */
use mpitools , only : send_real_array, receive_real_array use blocks , only : ndims, nsides, nfaces
use mpitools , only : nprocs, nproc use coordinates , only : toplev
use equations, only : nv #ifdef MPI
use coordinates , only : im, jm, km
#endif /* MPI */
use coordinates , only : ibl, ie, jbl, je, kbl, ke
#ifdef MPI
use equations , only : nv
use mpitools , only : nprocs, nproc
use mpitools , only : send_real_array, receive_real_array
#endif /* MPI */ #endif /* MPI */
! local variables are not implicit by default
!
implicit none implicit none
! local pointers
!
type(block_meta), pointer :: pmeta, pneigh
#ifdef MPI
type(block_info), pointer :: pinfo
#endif /* MPI */
! local variables ! local variables
! !
integer :: idir, iside, iface integer :: idir, iside, iface
integer :: is, js, ks integer :: is, js, ks
#ifdef MPI #ifdef MPI
integer :: irecv, isend, nblocks, itag, l, iret integer :: irecv, isend, nblocks, itag, l, iret
! local arrays
!
integer , dimension(NDIMS,0:nprocs-1,0:nprocs-1) :: block_counter
real(kind=8), dimension(:,:,:,:), allocatable :: rbuf
#endif /* MPI */ #endif /* MPI */
! local pointers
!
type(block_meta), pointer :: pmeta, pneigh
#ifdef MPI #ifdef MPI
type(block_info), pointer :: pinfo
! local pointer arrays ! local pointer arrays
! !
type(pointer_info), dimension(NDIMS,0:nprocs-1,0:nprocs-1) :: block_array type(pointer_info), dimension(ndims,0:nprocs-1,0:nprocs-1) :: block_array
#endif /* MPI */
#ifdef MPI
! local arrays
!
integer , dimension(ndims,0:nprocs-1,0:nprocs-1) :: block_counter
real(kind=8), dimension(:,:,:,:), allocatable :: rbuf
#endif /* MPI */ #endif /* MPI */
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
! do not correct fluxes if we do not use adaptive mesh ! do not correct fluxes if we do not use adaptive mesh
! !
if (toplev .eq. 1) return if (toplev == 1) return
#ifdef PROFILE #ifdef PROFILE
! start accounting time for flux boundary update ! start accounting time for flux boundary update
@ -394,37 +407,44 @@ module boundaries
#endif /* PROFILE */ #endif /* PROFILE */
#ifdef MPI #ifdef MPI
!! 1. PREPARE THE BLOCK EXCHANGE ARRAYS FOR MPI
!!
! reset the block counter ! reset the block counter
! !
block_counter(:,:,:) = 0 block_counter(:,:,:) = 0
! nullify info pointers ! nullify pointers to blocks which need to be exchanged between processes
! !
do irecv = 0, nprocs - 1 do irecv = 0, nprocs - 1
do isend = 0, nprocs - 1 do isend = 0, nprocs - 1
do idir = 1, NDIMS do idir = 1, ndims
nullify(block_array(idir,irecv,isend)%ptr) nullify(block_array(idir,irecv,isend)%ptr)
end do end do ! idir
end do end do ! isend
end do end do ! irecv
#endif /* MPI */ #endif /* MPI */
!! 2. UPDATE THE FLUX BOUNDARIES BETWEEN THE LOCAL BLOCKS
!!
! assign the pointer to the first block on the meta list
!
pmeta => list_meta
! scan all meta blocks in the list ! scan all meta blocks in the list
! !
pmeta => list_meta
do while(associated(pmeta)) do while(associated(pmeta))
! check if the meta block is a leaf ! check if the meta block is the leaf
! !
if (pmeta%leaf) then if (pmeta%leaf) then
! iterate over all neighbors ! iterate over all block neighbors
! !
do idir = 1, NDIMS do idir = 1, ndims
do iside = 1, nsides do iside = 1, nsides
do iface = 1, nfaces do iface = 1, nfaces
! associate pneigh with the current neighbor ! associate a pointer to the current neighbor
! !
pneigh => pmeta%neigh(idir,iside,iface)%ptr pneigh => pmeta%neigh(idir,iside,iface)%ptr
@ -432,14 +452,15 @@ module boundaries
! !
if (associated(pneigh)) then if (associated(pneigh)) then
! check if the current block lays at lower level than its neighbor ! check if the neighbor has high level than the current block
! !
if (pmeta%level .lt. pneigh%level) then if (pmeta%level < pneigh%level) then
#ifdef MPI #ifdef MPI
! check if the block and neighbor are on the local processors ! check if the block and neighbor belong to the same process, if so, update
! fluxes directly
! !
if (pmeta%cpu .eq. nproc .and. pneigh%cpu .eq. nproc) then if (pmeta%cpu == nproc .and. pneigh%cpu == nproc) then
#endif /* MPI */ #endif /* MPI */
! update directional flux from the neighbor ! update directional flux from the neighbor
@ -447,49 +468,65 @@ module boundaries
select case(idir) select case(idir)
case(1) case(1)
if (iside .eq. 1) then ! prepare the boundary layer index depending on the side
!
if (iside == 1) then
is = ie is = ie
else else
is = ibl is = ibl
end if end if
! correct the flux from the neighor at higher level
!
call correct_flux(pmeta%data & call correct_flux(pmeta%data &
, pneigh%data%f(idir,:,is,:,:), idir, iside, iface) , pneigh%data%f(idir,:,is,:,:), idir, iside, iface)
case(2) case(2)
if (iside .eq. 1) then ! prepare the boundary layer index depending on the side
!
if (iside == 1) then
js = je js = je
else else
js = jbl js = jbl
end if end if
! correct the flux from the neighor at higher level
!
call correct_flux(pmeta%data & call correct_flux(pmeta%data &
, pneigh%data%f(idir,:,:,js,:), idir, iside, iface) , pneigh%data%f(idir,:,:,js,:), idir, iside, iface)
#if NDIMS == 3 #if NDIMS == 3
case(3) case(3)
if (iside .eq. 1) then ! prepare the boundary layer index depending on the side
!
if (iside == 1) then
ks = ke ks = ke
else else
ks = kbl ks = kbl
end if end if
! correct the flux from the neighor at higher level
!
call correct_flux(pmeta%data & call correct_flux(pmeta%data &
, pneigh%data%f(idir,:,:,:,ks), idir, iside, iface) , pneigh%data%f(idir,:,:,:,ks), idir, iside, iface)
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
end select end select
#ifdef MPI #ifdef MPI
! block belong to different processes, therefore prepare the block exchange
! arrays
!
else else
! increase the counter for number of blocks to exchange ! increase the counter for the number of blocks to exchange
! !
block_counter(idir,pmeta%cpu,pneigh%cpu) = & block_counter(idir,pmeta%cpu,pneigh%cpu) = &
block_counter(idir,pmeta%cpu,pneigh%cpu) + 1 block_counter(idir,pmeta%cpu,pneigh%cpu) + 1
! allocate new info object ! allocate a new info object
! !
allocate(pinfo) allocate(pinfo)
@ -507,18 +544,21 @@ module boundaries
nullify(pinfo%prev) nullify(pinfo%prev)
nullify(pinfo%next) nullify(pinfo%next)
! if the list is not emply append the created block ! check if the list is empty
!
if (associated(block_array(idir,pmeta%cpu,pneigh%cpu)%ptr))&
then
! if it is, associate the newly created block with it
! !
if (associated(block_array(idir,pmeta%cpu,pneigh%cpu)%ptr)) then
pinfo%prev => block_array(idir,pmeta%cpu,pneigh%cpu)%ptr pinfo%prev => block_array(idir,pmeta%cpu,pneigh%cpu)%ptr
nullify(pinfo%next)
end if
! point the list to the last created block end if ! %ptr associated
! point the list to the newly created block
! !
block_array(idir,pmeta%cpu,pneigh%cpu)%ptr => pinfo block_array(idir,pmeta%cpu,pneigh%cpu)%ptr => pinfo
end if ! pmeta and pneigh on local cpu end if ! pmeta and pneigh on local process
#endif /* MPI */ #endif /* MPI */
end if ! pmeta level < pneigh level end if ! pmeta level < pneigh level
@ -531,19 +571,22 @@ module boundaries
end if ! leaf end if ! leaf
! associate the pointer with the next block
!
pmeta => pmeta%next ! assign pointer to the next meta block in the list pmeta => pmeta%next ! assign pointer to the next meta block in the list
end do ! meta blocks end do ! meta blocks
#ifdef MPI #ifdef MPI
! iterate over sending and receiving processors ! iterate over sending and receiving processes
! !
do irecv = 0, nprocs - 1 do irecv = 0, nprocs - 1
do isend = 0, nprocs - 1 do isend = 0, nprocs - 1
do idir = 1, NDIMS do idir = 1, ndims
! process only pairs which have boundaries to exchange ! process only pairs which have anything to exchange
! !
if (block_counter(idir,irecv,isend) .gt. 0) then if (block_counter(idir,irecv,isend) > 0) then
! obtain the number of blocks to exchange ! obtain the number of blocks to exchange
! !
@ -553,7 +596,7 @@ module boundaries
! !
itag = (irecv * nprocs + isend) * nprocs + idir itag = (irecv * nprocs + isend) * nprocs + idir
! allocate space for variables ! allocate the buffer for variables depending on the direction
! !
select case(idir) select case(idir)
case(1) case(1)
@ -568,98 +611,158 @@ 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
! fill out the buffer with the data from all blocks depepnding on the direction
!
select case(idir) select case(idir)
case(1) case(1)
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the list
!
do while(associated(pinfo)) do while(associated(pinfo))
if (pinfo%side .eq. 1) then ! increase the block count
!
l = l + 1
! prepare the ghost layer index depending on the side
!
if (pinfo%side == 1) then
is = ie is = ie
else else
is = ibl is = ibl
end if end if
! fill the buffer with data from the current block
!
rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,is,:,:) rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,is,:,:)
! associate the pointer with the next block
!
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1
end do end do ! %ptr blocks
case(2) case(2)
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the list
!
do while(associated(pinfo)) do while(associated(pinfo))
if (pinfo%side .eq. 1) then ! increase the block count
!
l = l + 1
! prepare the ghost layer index depending on the side
!
if (pinfo%side == 1) then
js = je js = je
else else
js = jbl js = jbl
end if end if
! fill the buffer with data from the current block
!
rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,:,js,:) rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,:,js,:)
! associate the pointer with the next block
!
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1
end do end do ! %ptr blocks
#if NDIMS == 3 #if NDIMS == 3
case(3) case(3)
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the list
!
do while(associated(pinfo)) do while(associated(pinfo))
if (pinfo%side .eq. 1) then ! increase the block count
!
l = l + 1
! prepare the ghost layer index depending on the side
!
if (pinfo%side == 1) then
ks = ke ks = ke
else else
ks = kbl ks = kbl
end if end if
! fill the buffer with data from the current block
!
rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,:,:,ks) rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,:,:,ks)
! associate the pointer with the next block
!
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1
end do end do ! %ptr blocks
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
end select end select
! send data buffer ! 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 ! isend = nproc end if ! isend = 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 fluxes ! reset the block counter
! !
l = 1 l = 0
! iterate over all received blocks and update fluxes depending on the direction
!
select case(idir) select case(idir)
case(1) case(1)
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the list
!
do while(associated(pinfo)) do while(associated(pinfo))
! set indices ! increase the block count
!
l = l + 1
! set side and face indices
! !
iside = pinfo%side iside = pinfo%side
iface = pinfo%face iface = pinfo%face
! set pointers ! associate pointers to the meta block and neighbor
! !
pmeta => pinfo%block pmeta => pinfo%block
pneigh => pmeta%neigh(idir,iside,iface)%ptr pneigh => pmeta%neigh(idir,iside,iface)%ptr
@ -669,24 +772,32 @@ module boundaries
call correct_flux(pmeta%data, rbuf(l,:,:,:) & call correct_flux(pmeta%data, rbuf(l,:,:,:) &
, idir, iside, iface) , idir, iside, iface)
! associate the pointer with the next block
!
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1 end do ! %ptr blocks
end do
case(2) case(2)
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the list
!
do while(associated(pinfo)) do while(associated(pinfo))
! set indices ! increase the block count
!
l = l + 1
! set side and face indices
! !
iside = pinfo%side iside = pinfo%side
iface = pinfo%face iface = pinfo%face
! set pointers ! associate pointers to the meta block and neighbor
! !
pmeta => pinfo%block pmeta => pinfo%block
pneigh => pmeta%neigh(idir,iside,iface)%ptr pneigh => pmeta%neigh(idir,iside,iface)%ptr
@ -696,25 +807,33 @@ module boundaries
call correct_flux(pmeta%data, rbuf(l,:,:,:) & call correct_flux(pmeta%data, rbuf(l,:,:,:) &
, idir, iside, iface) , idir, iside, iface)
! associate the pointer with the next block
!
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1 end do ! %ptr blocks
end do
#if NDIMS == 3 #if NDIMS == 3
case(3) case(3)
! associate the pointer with the first block in the exchange list
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the list
!
do while(associated(pinfo)) do while(associated(pinfo))
! set indices ! increase the block count
!
l = l + 1
! set side and face indices
! !
iside = pinfo%side iside = pinfo%side
iface = pinfo%face iface = pinfo%face
! set pointers ! associate pointers to the meta block and neighbor
! !
pmeta => pinfo%block pmeta => pinfo%block
pneigh => pmeta%neigh(idir,iside,iface)%ptr pneigh => pmeta%neigh(idir,iside,iface)%ptr
@ -724,35 +843,49 @@ module boundaries
call correct_flux(pmeta%data, rbuf(l,:,:,:) & call correct_flux(pmeta%data, rbuf(l,:,:,:) &
, idir, iside, iface) , idir, iside, iface)
! associate the pointer with the next block
!
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1 end do ! %ptr blocks
end do
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
end select end select
end if ! irecv = nproc end if ! irecv = nproc
! deallocate buffers ! deallocate data buffer
! !
deallocate(rbuf) deallocate(rbuf)
! deallocate info blocks ! associate the pointer with the first block in the exchange list
! !
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
! scan all blocks on the exchange list
!
do while(associated(pinfo)) do while(associated(pinfo))
! associate the exchange list pointer
!
block_array(idir,irecv,isend)%ptr => pinfo%prev block_array(idir,irecv,isend)%ptr => pinfo%prev
! nullify 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 info block
!
deallocate(pinfo) deallocate(pinfo)
! associate the pointer with the next block
!
pinfo => block_array(idir,irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
end do
end do ! %ptr blocks
end if ! if block_count > 0 end if ! if block_count > 0
end do ! idir end do ! idir