Rewrite the exchange of data for copying boundaries.

- this rewrite minimizes the amount of data transfered between
   processors for boundary update between blocks at the same level;
This commit is contained in:
Grzegorz Kowal 2011-05-16 18:51:59 -03:00
parent 36ee73800d
commit 062dde34e5

View File

@ -43,7 +43,7 @@ module boundaries
use blocks , only : ndims, nsides, nfaces use blocks , only : ndims, nsides, nfaces
use blocks , only : block_meta, block_data, block_info, pointer_info & use blocks , only : block_meta, block_data, block_info, pointer_info &
, list_meta , list_meta
use config , only : periodic use config , only : periodic, ng
use config , only : ib, ibu, iel, ie, jb, jbu, jel, je, kb, kbu, kel, ke use config , only : ib, ibu, iel, ie, jb, jbu, jel, je, kb, kbu, kel, ke
use timer , only : start_timer, stop_timer use timer , only : start_timer, stop_timer
#ifdef MPI #ifdef MPI
@ -207,22 +207,28 @@ module boundaries
select case(idir) select case(idir)
case(1) case(1)
if (iside .eq. 1) then if (iside .eq. 1) then
call boundary_copy(pdata, pneigh%data%u(:,iel:ie,:,:), idir, iside) call boundary_copy(pdata &
, pneigh%data%u(:,iel:ie,:,:), idir, iside)
else else
call boundary_copy(pdata, pneigh%data%u(:,ib:ibu,:,:), idir, iside) call boundary_copy(pdata &
, pneigh%data%u(:,ib:ibu,:,:), idir, iside)
end if end if
case(2) case(2)
if (iside .eq. 1) then if (iside .eq. 1) then
call boundary_copy(pdata, pneigh%data%u(:,:,jel:je,:), idir, iside) call boundary_copy(pdata &
, pneigh%data%u(:,:,jel:je,:), idir, iside)
else else
call boundary_copy(pdata, pneigh%data%u(:,:,jb:jbu,:), idir, iside) call boundary_copy(pdata &
, pneigh%data%u(:,:,jb:jbu,:), idir, iside)
end if end if
#if NDIMS == 3 #if NDIMS == 3
case(3) case(3)
if (iside .eq. 1) then if (iside .eq. 1) then
call boundary_copy(pdata, pneigh%data%u(:,:,:,kel:ke), idir, iside) call boundary_copy(pdata &
, pneigh%data%u(:,:,:,kel:ke), idir, iside)
else else
call boundary_copy(pdata, pneigh%data%u(:,:,:,kb:kbu), idir, iside) call boundary_copy(pdata &
, pneigh%data%u(:,:,:,kb:kbu), idir, iside)
end if end if
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
end select end select
@ -372,30 +378,78 @@ module boundaries
! allocate space for variables ! allocate space for variables
! !
allocate(rbuf(nblocks,nqt,im,jm,km)) select case(idir)
case(1)
allocate(rbuf(nblocks,nqt,ng,jm,km))
case(2)
allocate(rbuf(nblocks,nqt,im,ng,km))
#if NDIMS == 3
case(3)
allocate(rbuf(nblocks,nqt,im,jm,ng))
#endif /* NDIMS == 3 */
end select
! if isend == ncpu we are sending data ! if isend == ncpu we are sending data
! !
if (isend .eq. ncpu) then if (isend .eq. ncpu) then
! fill out the buffer with block data ! iterate over exchange blocks along the current direction and fill out
! the buffer with the block data
! !
l = 1 select case(idir)
case(1)
l = 1
pinfo => block_array(1,irecv,isend)%ptr
do while(associated(pinfo))
pinfo => block_array(1,irecv,isend)%ptr if (pinfo%side .eq. 1) then
do while(associated(pinfo)) rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,iel:ie,:,:)
else
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,ib:ibu,:,:)
end if
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,:,:) pinfo => pinfo%prev
l = l + 1
end do
pinfo => pinfo%prev case(2)
l = l + 1 l = 1
end do pinfo => block_array(1,irecv,isend)%ptr
do while(associated(pinfo))
! send data buffer if (pinfo%side .eq. 1) then
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,jel:je,:)
else
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,jb:jbu,:)
end if
pinfo => pinfo%prev
l = l + 1
end do
#if NDIMS == 3
case(3)
l = 1
pinfo => block_array(1,irecv,isend)%ptr
do while(associated(pinfo))
if (pinfo%side .eq. 1) then
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,:,kel:ke)
else
rbuf(l,:,:,:,:) = pinfo%neigh%data%u(:,:,:,kb:kbu)
end if
pinfo => pinfo%prev
l = l + 1
end do
#endif /* NDIMS == 3 */
end select
! send the data buffer
! !
call msendf(size(rbuf), irecv, itag, rbuf(:,:,:,:,:)) call msendf(size(rbuf), irecv, itag, rbuf(:,:,:,:,:))
end if end if ! isend = ncpu
! if irecv == ncpu we are receiving data ! if irecv == ncpu we are receiving data
! !
@ -405,32 +459,59 @@ module boundaries
! !
call mrecvf(size(rbuf(:,:,:,:,:)), isend, itag, rbuf(:,:,:,:,:)) call mrecvf(size(rbuf(:,:,:,:,:)), isend, itag, rbuf(:,:,:,:,:))
! iterate over all received blocks and update boundaries ! update boundaries using the data received in the buffer
! !
l = 1 select case(idir)
case(1)
l = 1
pinfo => block_array(1,irecv,isend)%ptr
do while(associated(pinfo))
pinfo => block_array(1,irecv,isend)%ptr iside = pinfo%side
do while(associated(pinfo)) pdata => pinfo%block%data
! set indices call boundary_copy(pdata, rbuf(l,:,:,:,:), idir, iside)
!
iside = pinfo%side
iface = pinfo%face
! update boundaries pinfo => pinfo%prev
! l = l + 1
if (pinfo%level_difference .eq. 0 .and. iface .eq. 1) & end do
call bnd_copy(pinfo%block%data, rbuf(l,:,:,:,:), idir, iside)
pinfo => pinfo%prev case(2)
l = l + 1 l = 1
end do pinfo => block_array(1,irecv,isend)%ptr
do while(associated(pinfo))
end if iside = pinfo%side
pdata => pinfo%block%data
call boundary_copy(pdata, rbuf(l,:,:,:,:), idir, iside)
pinfo => pinfo%prev
l = l + 1
end do
#if NDIMS == 3
case(3)
l = 1
pinfo => block_array(1,irecv,isend)%ptr
do while(associated(pinfo))
iside = pinfo%side
pdata => pinfo%block%data
call boundary_copy(pdata, rbuf(l,:,:,:,:), idir, iside)
pinfo => pinfo%prev
l = l + 1
end do
#endif /* NDIMS == 3 */
end select
end if ! irecv = ncpu
! deallocate buffers ! deallocate buffers
! !
deallocate(rbuf) if (allocated(rbuf)) deallocate(rbuf)
! deallocate info blocks ! deallocate info blocks
! !
@ -450,6 +531,8 @@ module boundaries
end if ! if block_count > 0 end if ! if block_count > 0
!! process blocks with the neighbors at higher levels
!!
! process only pairs which have boundaries to exchange ! process only pairs which have boundaries to exchange
! !
if (block_counter(2,irecv,isend) .gt. 0) then if (block_counter(2,irecv,isend) .gt. 0) then