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

Reduce the amount of data exchanged in the flux update.

Browse Source
This commit is contained in:
Grzegorz Kowal 2011-05-14 21:36:10 -03:00
parent fae2fb8ca2
commit af1e78a2f8
1 changed files with 226 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

255
src/boundaries.F90
View File

@ -879,6 +879,7 @@ module boundaries
use blocks , only : block_meta, block_data, list_meta use blocks , only : block_meta, block_data, list_meta
use blocks , only : nsides, nfaces use blocks , only : nsides, nfaces
use config , only : maxlev use config , only : maxlev
use config , only : ibl, ie, jbl, je, kbl, ke
use timer , only : start_timer, stop_timer use timer , only : start_timer, stop_timer
#ifdef MPI #ifdef MPI
use blocks , only : block_info, pointer_info use blocks , only : block_info, pointer_info
@ -892,13 +893,14 @@ module boundaries
! local variables ! local variables
! !
integer :: idir, iside, iface integer :: idir, iside, iface
integer :: is, js, ks
#ifdef MPI #ifdef MPI
integer :: irecv, isend, nblocks, itag, l integer :: irecv, isend, nblocks, itag, l
! local arrays ! local arrays
! !
integer , dimension(0:ncpus-1,0:ncpus-1) :: block_counter integer , dimension(NDIMS,0:ncpus-1,0:ncpus-1) :: block_counter
real(kind=8), dimension(:,:,:,:,:,:), allocatable :: rbuf real(kind=8), dimension(:,:,:,:), allocatable :: rbuf
#endif /* MPI */ #endif /* MPI */
! local pointers ! local pointers
@ -909,7 +911,7 @@ module boundaries
! local pointer arrays ! local pointer arrays
! !
type(pointer_info), dimension(0:ncpus-1,0:ncpus-1) :: block_array type(pointer_info), dimension(NDIMS,0:ncpus-1,0:ncpus-1) :: block_array
#endif /* MPI */ #endif /* MPI */
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -925,13 +927,15 @@ module boundaries
#ifdef MPI #ifdef MPI
! reset the block counter ! reset the block counter
! !
block_counter(:,:) = 0 block_counter(:,:,:) = 0
! nullify info pointers ! nullify info pointers
! !
do irecv = 0, ncpus - 1 do irecv = 0, ncpus - 1
do isend = 0, ncpus - 1 do isend = 0, ncpus - 1
nullify(block_array(irecv,isend)%ptr) do idir = 1, NDIMS
nullify(block_array(idir,irecv,isend)%ptr)
end do
end do end do
end do end do
#endif /* MPI */ #endif /* MPI */
@ -971,15 +975,50 @@ module boundaries
! update directional flux from the neighbor ! update directional flux from the neighbor
! !
call correct_flux(pmeta%data, pneigh%data%f & select case(idir)
, idir, iside, iface) case(1)
if (iside .eq. 1) then
is = ie
else
is = ibl
end if
call correct_flux(pmeta%data &
, pneigh%data%f(idir,:,is,:,:), idir, iside, iface)
case(2)
if (iside .eq. 1) then
js = je
else
js = jbl
end if
call correct_flux(pmeta%data &
, pneigh%data%f(idir,:,:,js,:), idir, iside, iface)
#if NDIMS == 3
case(3)
if (iside .eq. 1) then
ks = ke
else
ks = kbl
end if
call correct_flux(pmeta%data &
, pneigh%data%f(idir,:,:,:,ks), idir, iside, iface)
#endif /* NDIMS == 3 */
end select
#ifdef MPI #ifdef MPI
else else
! increase the counter for number of blocks to exchange ! increase the counter for number of blocks to exchange
! !
block_counter(pmeta%cpu,pneigh%cpu) = & block_counter(idir,pmeta%cpu,pneigh%cpu) = &
block_counter(pmeta%cpu,pneigh%cpu) + 1 block_counter(idir,pmeta%cpu,pneigh%cpu) + 1
! allocate new info object ! allocate new info object
! !
@ -1001,14 +1040,14 @@ module boundaries
! if the list is not emply append the created block ! if the list is not emply append the created block
! !
if (associated(block_array(pmeta%cpu,pneigh%cpu)%ptr)) then if (associated(block_array(idir,pmeta%cpu,pneigh%cpu)%ptr)) then
pinfo%prev => block_array(pmeta%cpu,pneigh%cpu)%ptr pinfo%prev => block_array(idir,pmeta%cpu,pneigh%cpu)%ptr
nullify(pinfo%next) nullify(pinfo%next)
end if end if
! point the list to the last created block ! point the list to the last created block
! !
block_array(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 cpu
#endif /* MPI */ #endif /* MPI */
@ -1031,22 +1070,32 @@ module boundaries
! !
do irecv = 0, ncpus - 1 do irecv = 0, ncpus - 1
do isend = 0, ncpus - 1 do isend = 0, ncpus - 1
do idir = 1, NDIMS
! process only pairs which have boundaries to exchange ! process only pairs which have boundaries to exchange
! !
if (block_counter(irecv,isend) .gt. 0) then if (block_counter(idir,irecv,isend) .gt. 0) then
! obtain the number of blocks to exchange ! obtain the number of blocks to exchange
! !
nblocks = block_counter(irecv,isend) nblocks = block_counter(idir,irecv,isend)
! prepare the tag for communication ! prepare the tag for communication
! !
itag = irecv * ncpus + isend + ncpus + 1 itag = (irecv * ncpus + isend) * ncpus + idir
! allocate space for variables ! allocate space for variables
! !
allocate(rbuf(nblocks,NDIMS,nqt,im,jm,km)) select case(idir)
case(1)
allocate(rbuf(nblocks,nqt,jm,km))
case(2)
allocate(rbuf(nblocks,nqt,im,km))
#if NDIMS == 3
case(3)
allocate(rbuf(nblocks,nqt,im,jm))
#endif /* NDIMS == 3 */
end select
! if isend == ncpu we are sending data ! if isend == ncpu we are sending data
! !
@ -1056,20 +1105,66 @@ module boundaries
! !
l = 1 l = 1
pinfo => block_array(irecv,isend)%ptr select case(idir)
case(1)
pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo)) do while(associated(pinfo))
rbuf(l,:,:,:,:,:) = pinfo%neigh%data%f(:,:,:,:,:) if (pinfo%side .eq. 1) then
is = ie
else
is = ibl
end if
rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,is,:,:)
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1 l = l + 1
end do end do
case(2)
pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo))
if (pinfo%side .eq. 1) then
js = je
else
js = jbl
end if
rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,:,js,:)
pinfo => pinfo%prev
l = l + 1
end do
#if NDIMS == 3
case(3)
pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo))
if (pinfo%side .eq. 1) then
ks = ke
else
ks = kbl
end if
rbuf(l,:,:,:) = pinfo%neigh%data%f(idir,:,:,:,ks)
pinfo => pinfo%prev
l = l + 1
end do
#endif /* NDIMS == 3 */
end select
! send data buffer ! send 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
! !
@ -1077,41 +1172,98 @@ module boundaries
! receive data ! receive data
! !
call mrecvf(size(rbuf(:,:,:,:,:,:)), isend, itag, rbuf(:,:,:,:,:,:)) call mrecvf(size(rbuf(:,:,:,:)), isend, itag, rbuf(:,:,:,:))
! iterate over all received blocks and update boundaries ! iterate over all received blocks and update fluxes
! !
l = 1 l = 1
pinfo => block_array(irecv,isend)%ptr select case(idir)
case(1)
pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo)) do while(associated(pinfo))
! set indices ! set indices
! !
idir = pinfo%direction
iside = pinfo%side iside = pinfo%side
iface = pinfo%face iface = pinfo%face
! update boundaries ! set pointers
! !
if (pinfo%level_difference .eq. -1) then
pmeta => pinfo%block pmeta => pinfo%block
pneigh => pmeta%neigh(idir,iside,iface)%ptr pneigh => pmeta%neigh(idir,iside,iface)%ptr
! update directional flux from the neighbor ! update fluxes
! !
call correct_flux(pmeta%data, rbuf(l,:,:,:,:,:) & call correct_flux(pmeta%data, rbuf(l,:,:,:) &
, idir, iside, iface) , idir, iside, iface)
end if
pinfo => pinfo%prev pinfo => pinfo%prev
l = l + 1 l = l + 1
end do end do
end if case(2)
pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo))
! set indices
!
iside = pinfo%side
iface = pinfo%face
! set pointers
!
pmeta => pinfo%block
pneigh => pmeta%neigh(idir,iside,iface)%ptr
! update fluxes
!
call correct_flux(pmeta%data, rbuf(l,:,:,:) &
, idir, iside, iface)
pinfo => pinfo%prev
l = l + 1
end do
#if NDIMS == 3
case(3)
pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo))
! set indices
!
iside = pinfo%side
iface = pinfo%face
! set pointers
!
pmeta => pinfo%block
pneigh => pmeta%neigh(idir,iside,iface)%ptr
! update fluxes
!
call correct_flux(pmeta%data, rbuf(l,:,:,:) &
, idir, iside, iface)
pinfo => pinfo%prev
l = l + 1
end do
#endif /* NDIMS == 3 */
end select
end if ! irecv = ncpu
! deallocate buffers ! deallocate buffers
! !
@ -1119,9 +1271,9 @@ module boundaries
! deallocate info blocks ! deallocate info blocks
! !
pinfo => block_array(irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
do while(associated(pinfo)) do while(associated(pinfo))
block_array(irecv,isend)%ptr => pinfo%prev block_array(idir,irecv,isend)%ptr => pinfo%prev
nullify(pinfo%prev) nullify(pinfo%prev)
nullify(pinfo%next) nullify(pinfo%next)
@ -1130,10 +1282,11 @@ module boundaries
deallocate(pinfo) deallocate(pinfo)
pinfo => block_array(irecv,isend)%ptr pinfo => block_array(idir,irecv,isend)%ptr
end do end do
end if ! if block_count > 0 end if ! if block_count > 0
end do ! idir
end do ! isend end do ! isend
end do ! irecv end do ! irecv
#endif /* MPI */ #endif /* MPI */
@ -1162,16 +1315,16 @@ module boundaries
! local variables ! local variables
! !
integer :: i, ip, is, it, ih, il, iu, i1, i2 integer :: i, ip, it, ih, il, iu, i1, i2
integer :: j, jp, js, jt, jh, jl, ju, j1, j2 integer :: j, jp, jt, jh, jl, ju, j1, j2
#if NDIMS == 3 #if NDIMS == 3
integer :: k, kp, ks, kt, kh, kl, ku, k1, k2 integer :: k, kp, kt, kh, kl, ku, k1, k2
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
! arguments ! arguments
! !
type(block_data), pointer , intent(inout) :: pdata type(block_data), pointer , intent(inout) :: pdata
real , dimension(:,:,:,:,:), intent(in) :: f real , dimension(:,:,:), intent(in) :: f
integer , intent(in) :: idir, iside, iface integer , intent(in) :: idir, iside, iface
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -1185,10 +1338,8 @@ module boundaries
! index of the slice which will be updated ! index of the slice which will be updated
! !
if (iside .eq. 1) then ! left side if (iside .eq. 1) then ! left side
is = ie
it = ibl it = ibl
else ! right side else ! right side
is = ibl
it = ie it = ie
end if end if
@ -1217,7 +1368,7 @@ module boundaries
j1 = 2 * (j - jl) + jb j1 = 2 * (j - jl) + jb
j2 = j1 + 1 j2 = j1 + 1
pdata%f(idir,:,it,j,:) = 0.5d0 * (f(idir,:,is,j1,:) + f(idir,:,is,j2,:)) pdata%f(idir,:,it,j,:) = 0.5d0 * (f(:,j1,:) + f(:,j2,:))
end do end do
#endif /* NDIMS == 2 */ #endif /* NDIMS == 2 */
#if NDIMS == 3 #if NDIMS == 3
@ -1228,8 +1379,8 @@ module boundaries
k1 = 2 * (k - kl) + kb k1 = 2 * (k - kl) + kb
k2 = k1 + 1 k2 = k1 + 1
pdata%f(idir,:,it,j,k) = (f(idir,:,is,j1,k1) + f(idir,:,is,j2,k1) & pdata%f(idir,:,it,j,k) = 0.25d0 * (f(:,j1,k1) + f(:,j2,k1) &
+ f(idir,:,is,j1,k2) + f(idir,:,is,j2,k2)) / 0.25d0 + f(:,j1,k2) + f(:,j2,k2))
end do end do
end do end do
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
@ -1241,10 +1392,8 @@ module boundaries
! index of the slice which will be updated ! index of the slice which will be updated
! !
if (iside .eq. 1) then ! left side if (iside .eq. 1) then ! left side
js = je
jt = jbl jt = jbl
else ! right side else ! right side
js = jbl
jt = je jt = je
end if end if
@ -1273,7 +1422,7 @@ module boundaries
i1 = 2 * (i - il) + ib i1 = 2 * (i - il) + ib
i2 = i1 + 1 i2 = i1 + 1
pdata%f(idir,:,i,jt,:) = 0.5d0 * (f(idir,:,i1,js,:) + f(idir,:,i2,js,:)) pdata%f(idir,:,i,jt,:) = 0.5d0 * (f(:,i1,:) + f(:,i2,:))
end do end do
#endif /* NDIMS == 2 */ #endif /* NDIMS == 2 */
#if NDIMS == 3 #if NDIMS == 3
@ -1285,8 +1434,8 @@ module boundaries
k1 = 2 * (k - kl) + kb k1 = 2 * (k - kl) + kb
k2 = k1 + 1 k2 = k1 + 1
pdata%f(idir,:,i,jt,k) = (f(idir,:,i1,js,k1) + f(idir,:,i2,js,k1) & pdata%f(idir,:,i,jt,k) = 0.25d0 * (f(:,i1,k1) + f(:,i2,k1) &
+ f(idir,:,i1,js,k2) + f(idir,:,i2,js,k2)) * 0.25d0 + f(:,i1,k2) + f(:,i2,k2))
end do end do
end do end do
#endif /* NDIMS == 3 */ #endif /* NDIMS == 3 */
@ -1299,10 +1448,8 @@ module boundaries
! index of the slice which will be updated ! index of the slice which will be updated
! !
if (iside .eq. 1) then ! left side if (iside .eq. 1) then ! left side
ks = ke
kt = kbl kt = kbl
else ! right side else ! right side
ks = kbl
kt = ke kt = ke
end if end if
@ -1330,8 +1477,8 @@ module boundaries
j1 = 2 * (j - jl) + jb j1 = 2 * (j - jl) + jb
j2 = j1 + 1 j2 = j1 + 1
pdata%f(idir,:,i,j,kt) = (f(idir,:,i1,j1,ks) + f(idir,:,i2,j1,ks) & pdata%f(idir,:,i,j,kt) = 0.25d0 * (f(:,i1,j1) + f(:,i2,j1) &
+ f(idir,:,i1,j2,ks) + f(idir,:,i2,j2,ks)) * 0.25d0 + f(:,i1,j2) + f(:,i2,j2))
end do end do
end do end do