First approach to implement MPI refinement.

It seems to be pretty complex. So far I collect blocks selected for
refinement which have neighbors laying on other processors. Using this I
set the neighbors from other processors for refinement if required. The
remaining things are the neighbors update after refinement and MPI
version of derefinement.
This commit is contained in:
Grzegorz Kowal 2009-01-03 22:49:04 -06:00
parent c686e301fc
commit c216adb422
3 changed files with 305 additions and 108 deletions

View File

@ -54,7 +54,6 @@ module boundaries
integer :: i, j, k, p, l, dl integer :: i, j, k, p, l, dl
#ifdef MPI #ifdef MPI
integer(kind=4) :: itag integer(kind=4) :: itag
logical :: lf logical :: lf
@ -111,9 +110,11 @@ module boundaries
else else
#ifdef MPI
! neighbor associated; exchange boundaries ! neighbor associated; exchange boundaries
! !
if (pblock%neigh(i,j,k)%cpu .eq. ncpu) then if (pblock%neigh(i,j,k)%cpu .eq. ncpu) then
#endif /* MPI */
! neighbor is on the same CPU, update ! neighbor is on the same CPU, update
! !
@ -158,8 +159,9 @@ module boundaries
iblk(p,cn(p),4) = i ! 4: directions of boundary iblk(p,cn(p),4) = i ! 4: directions of boundary
iblk(p,cn(p),5) = j ! 5: side at the boundary iblk(p,cn(p),5) = j ! 5: side at the boundary
iblk(p,cn(p),6) = k ! 6: part of the boundary iblk(p,cn(p),6) = k ! 6: part of the boundary
#endif /* MPI */
endif endif
#endif /* MPI */
endif endif
end do end do

View File

@ -122,17 +122,17 @@ module evolution
call mallreduceminr(dtn) call mallreduceminr(dtn)
#endif /* MPI */ #endif /* MPI */
! ! check refinement and refine ! check refinement and refine
! !
! call start_timer(5)
! call update_mesh(0)
! call stop_timer(5)
! !
! ! update boundaries call start_timer(5)
! ! call update_mesh(0)
! call start_timer(4) call stop_timer(5)
! call boundary
! call stop_timer(4) ! update boundaries
!
call start_timer(4)
call boundary
call stop_timer(4)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !

View File

@ -369,8 +369,12 @@ module mesh
subroutine update_mesh(ref) subroutine update_mesh(ref)
use config , only : maxlev use config , only : maxlev
use blocks , only : block, plist, ndims, nchild, refine_block, get_pointer use blocks , only : block, plist, ndims, nchild, nblocks, refine_block &
, get_pointer
use error , only : print_info use error , only : print_info
#ifdef MPI
use mpitools, only : ncpus, ncpu, mallreducemaxl, msendi, mrecvi
#endif /* MPI */
use problem , only : check_ref use problem , only : check_ref
implicit none implicit none
@ -380,12 +384,38 @@ module mesh
! local variables ! local variables
! !
type(block), pointer :: pblock, pneigh, pchild, pparent type(block), pointer :: pblock, pneigh, pchild, pparent
integer(kind=4) :: l, i, j, k, n, p integer(kind=4) :: l, i, j, k, m, n, p, q
#ifdef MPI
integer(kind=4) :: itag
! local arrays for MPI
!
integer(kind=4), dimension(:,:,:) , allocatable :: iblk, ichl
integer(kind=4), dimension(:,:) , allocatable :: cn, cc, ibuf
#endif /* MPI */
!---------------------------------------------------------------------- !----------------------------------------------------------------------
! !
#ifdef MPI
! allocate temporary arrays; since we have two blocks per boundary and 4 sides
! of each block we need to increase the second dimension
!
allocate(cn (0:ncpus-1,0:ncpus-1))
allocate(cc (0:ncpus-1,0:ncpus-1))
allocate(iblk(0:ncpus-1,2**(NDIMS-1)*NDIMS*nblocks,3))
allocate(ichl(0:ncpus-1,2**(NDIMS-1)*NDIMS*nblocks,7))
#endif /* MPI */
do l = 1, maxlev do l = 1, maxlev
#ifdef MPI
! reset the local arrays storing blocks to exchange
!
cn(:,:) = 0
iblk(:,:,:) = 0
#endif /* MPI */
! check refinement criterion ! check refinement criterion
! !
pblock => plist pblock => plist
@ -410,7 +440,7 @@ module mesh
! refinement conditions for blocks: ! refinement conditions for blocks:
! !
! - all neighbors must be at the same or lower level ! - all neighbors must be at the same or one level higher
! !
do n = l, 2, -1 do n = l, 2, -1
pblock => plist pblock => plist
@ -421,11 +451,36 @@ module mesh
do i = 1, ndims do i = 1, ndims
do j = 1, 2 do j = 1, 2
do k = 1, 2 do k = 1, 2
#ifdef MPI
if (pblock%neigh(i,j,k)%cpu .eq. ncpu) then
#endif /* MPI */
pneigh => get_pointer(pblock%neigh(i,j,k)%id) pneigh => get_pointer(pblock%neigh(i,j,k)%id)
if (associated(pneigh)) then if (associated(pneigh)) then
if (pneigh%level .lt. pblock%level) & if (pneigh%level .lt. pblock%level) &
pneigh%refine = 1 pneigh%refine = 1
endif endif
#ifdef MPI
else
! TODO: fill temporary array with neighbors of the current block laying on other processes
! this array should store current block ID and level, and neighbor ID
!
! get the processor number of neighbor
!
p = pblock%neigh(i,j,k)%cpu
! increase the number of blocks to retrieve from that CPU
!
cn(ncpu,p) = cn(ncpu,p) + 1
! fill out the info array
!
iblk(p,cn(ncpu,p),1) = pblock%id
iblk(p,cn(ncpu,p),2) = pblock%level
iblk(p,cn(ncpu,p),3) = pblock%neigh(i,j,k)%id
endif
#endif /* MPI */
end do end do
end do end do
@ -435,9 +490,57 @@ module mesh
pblock => pblock%next pblock => pblock%next
end do end do
#ifdef MPI
! TODO: after sweeping the current level, send the temporary array to neighbors
! and select them for refinement if their level is lower
!
! update number of blocks across all processes
!
call mallreducemaxl(size(cn),cn)
if (maxval(cn) .gt. 0) then
allocate(ibuf(maxval(cn),3))
do p = 0, ncpus-1
do q = 0, ncpus-1
itag = 10*(p * ncpus + q) + 2111
if (cn(p,q) .gt. 0) then
if (ncpu .eq. p) then ! sender
call msendi(size(iblk(q,1:cn(p,q),:)), q, itag, iblk(q,1:cn(p,q),:))
endif
if (ncpu .eq. q) then ! receiver
call mrecvi(size(ibuf(1:cn(p,q),:)), p, itag, ibuf(1:cn(p,q),:))
do i = 1, cn(p,q)
pblock => get_pointer(ibuf(i,3))
if (pblock%level .lt. ibuf(i,2)) &
pblock%refine = 1
end do
endif
endif
end do
end do end do
deallocate(ibuf)
endif
#endif /* MPI */
end do
! after selecting blocks for refinement, do refine them gradually starting from
! the lowest level in order to avoid situation when two neighbors have level
! difference larger than 2
!
do n = 1, l do n = 1, l
#ifdef MPI
cc (:,:) = 0
ichl(:,:,:) = 0
#endif /* MPI */
pblock => plist pblock => plist
do while (associated(pblock)) do while (associated(pblock))
@ -448,114 +551,206 @@ module mesh
call refine_block(pblock) call refine_block(pblock)
call prolong_block(pparent) call prolong_block(pparent)
endif
endif
pblock => pblock%next #ifdef MPI
! TODO: collect information about refined block in order to update neighbors
! laying on other processors
end do
end do
end do
! else
do l = maxlev, 1, -1
! derefinement conditions for blocks:
!
! - all neighbors must be at the same or lower level
! - all neighbors at the same level must be not selected for refinement
! - all sibling must be at the same level and marked for derefinement
!
! if all above conditions are fulfilled, select the refinement of
! the parent of the current block to -1
!
! if at least one is not fulfilled, set all sibling to not do the refinement
!
do n = l, maxlev
pblock => plist
do while (associated(pblock))
if (pblock%level .eq. n) then
if (pblock%leaf .and. pblock%refine .eq. -1) then
do i = 1, ndims do i = 1, ndims
do j = 1, 2 do j = 1, 2
do k = 1, 2 do k = 1, 2
pneigh => get_pointer(pblock%neigh(i,j,k)%id) if (pparent%neigh(i,j,k)%cpu .ne. ncpu) then
if (associated(pneigh)) then p = pparent%neigh(i,j,k)%cpu
if (pneigh%level .gt. pblock%level) & cc(ncpu,p) = cc(ncpu,p) + 1
pblock%refine = 0 ichl(p,cc(ncpu,p),1) = pparent%neigh(i,j,k)%id
if (pneigh%level .eq. pblock%level .and. pneigh%refine .eq. 1) & ichl(p,cc(ncpu,p),2) = pparent%id
pblock%refine = 0 ichl(p,cc(ncpu,p),3) = pparent%level
endif ichl(p,cc(ncpu,p),4) = pparent%child(1)%id
ichl(p,cc(ncpu,p),5) = pparent%child(2)%id
end do ichl(p,cc(ncpu,p),6) = pparent%child(3)%id
end do ichl(p,cc(ncpu,p),7) = pparent%child(4)%id
end do
pparent => get_pointer(pblock%parent%id)
if (associated(pparent)) then
do p = 1, nchild
pchild => get_pointer(pparent%child(p)%id)
if (associated(pchild)) then
if (pchild%refine .ne. -1 .or. pchild%level .ne. pblock%level) &
pblock%refine = 0
endif endif
end do end do
if (pblock%refine .ne. -1) then
do p = 1, nchild
pchild => get_pointer(pparent%child(p)%id)
if (associated(pchild)) then
if (pchild%refine .eq. -1 .and. pchild%level .eq. pblock%level) &
pchild%refine = 0
endif
end do end do
endif end do
endif #endif /* MPI */
endif ! TODO: remove parent after refinement
endif
pparent => get_pointer(pblock%parent%id)
if (associated(pparent) .and. pblock%refine .eq. -1) &
pparent%refine = -1
! point to the next block
! !
pblock => pblock%next
end do
end do
! perform derefinements for all selected blocks
!
do n = maxlev, l, -1
pblock => plist
do while (associated(pblock))
if (pblock%level .eq. n) then
if (pblock%leaf .and. pblock%refine .eq. -1) then
pparent => get_pointer(pblock%parent%id)
if (associated(pparent) .and. pparent%refine .eq. -1) then
! print *, 'derefine block ', pparent%id
call restrict_block(pparent)
pblock => pparent
endif
endif endif
endif endif
pblock => pblock%next pblock => pblock%next
end do
end do
end do end do
#ifdef MPI
! TODO: exchange information about refined blocks in order to update neighbors
!
call mallreducemaxl(size(cc),cc)
if (maxval(cc) .gt. 0) then
allocate(ibuf(maxval(cc),7))
do p = 0, ncpus-1
do q = 0, ncpus-1
itag = 10*(p * ncpus + q) + 3111
if (cc(p,q) .gt. 0) then
if (ncpu .eq. p) then ! sender
call msendi(size(ichl(q,1:cc(p,q),:)), q, itag, ichl(q,1:cc(p,q),:))
endif
if (ncpu .eq. q) then ! receiver
call mrecvi(size(ibuf(1:cc(p,q),:)), p, itag, ibuf(1:cc(p,q),:))
do m = 1, cn(p,q)
pblock => get_pointer(ibuf(m,1))
if (pblock%leaf) then
! TODO: if leaf, update its neighbors according to the information sent
!
do i = 1, ndims
do j = 1, 2
do k = 1, 2
if (pblock%neigh(i,j,k)%cpu .eq. p) then
if (pblock%neigh(i,j,k)%id .eq. ibuf(m,2)) then
! TODO: depending in the level difference and side update neighbors
!
! if (pblock%level .eq. ibuf(m,3) then
! endif ! endif
! pblock%neigh(i,j,k)%id =
endif
endif
end do
end do
end do
else
! TODO: if not leaf, it means that the block has been refined in the meantime, so
! update its children
!
endif
end do
endif
endif
end do
end do
deallocate(ibuf)
endif
#endif /* MPI */
end do
end do
! ! iterate starting from the maximum level and select blocks for derefinement
! ! if they fullfil below conditions
! !
! do l = maxlev, 1, -1
!
! ! derefinement conditions for blocks:
! !
! ! - all neighbors must be at the same or lower level
! ! - all neighbors at the same level must be not selected for refinement
! ! - all sibling must be at the same level and marked for derefinement
! !
! ! if all above conditions are fulfilled, select the refinement of
! ! the parent of the current block to -1
! !
! ! if at least one is not fulfilled, set all sibling to not do the refinement
! !
! do n = l, maxlev
! pblock => plist
! do while (associated(pblock))
!
! if (pblock%level .eq. n) then
! if (pblock%leaf .and. pblock%refine .eq. -1) then
! do i = 1, ndims
! do j = 1, 2
! do k = 1, 2
! pneigh => get_pointer(pblock%neigh(i,j,k)%id)
! if (associated(pneigh)) then
! if (pneigh%level .gt. pblock%level) &
! pblock%refine = 0
! if (pneigh%level .eq. pblock%level .and. pneigh%refine .eq. 1) &
! pblock%refine = 0
! endif
!
! end do
! end do
! end do
!
! pparent => get_pointer(pblock%parent%id)
! if (associated(pparent)) then
! do p = 1, nchild
! pchild => get_pointer(pparent%child(p)%id)
!
! if (associated(pchild)) then
! if (pchild%refine .ne. -1 .or. pchild%level .ne. pblock%level) &
! pblock%refine = 0
! endif
! end do
!
! if (pblock%refine .ne. -1) then
! do p = 1, nchild
! pchild => get_pointer(pparent%child(p)%id)
!
! if (associated(pchild)) then
! if (pchild%refine .eq. -1 .and. pchild%level .eq. pblock%level) &
! pchild%refine = 0
! endif
! end do
! endif
! endif
!
! endif
! endif
!
! pparent => get_pointer(pblock%parent%id)
! if (associated(pparent) .and. pblock%refine .eq. -1) &
! pparent%refine = -1
!
! ! point to the next block
! !
! pblock => pblock%next
! end do
! end do
!
! ! perform derefinement for all selected blocks
! !
! do n = maxlev, l, -1
! pblock => plist
! do while (associated(pblock))
!
! if (pblock%level .eq. n) then
! if (pblock%leaf .and. pblock%refine .eq. -1) then
!
! pparent => get_pointer(pblock%parent%id)
!
! if (associated(pparent) .and. pparent%refine .eq. -1) then
! call restrict_block(pparent)
! pblock => pparent
! endif
! endif
! endif
!
! pblock => pblock%next
! end do
! end do
!
! end do
#ifdef MPI
! deallocate temporary arrays
!
deallocate(cc)
deallocate(ichl)
deallocate(cn)
deallocate(iblk)
#endif /* MPI */
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !