Create generic interfaces for gather/scatter operations.
Gathers and scatters between global fields and fields on the local physics or dynamics decomposition are done for
select case (tape(t)%hlist(f)%field%decomp_type)
case (phys_decomp)
call gather_chunk_to_field_hbuf (1, numlev, 1, plon, tape(t)%hlist(f)%hbuf, hbuf)
call gather_chunk_to_field_int (1, 1, 1, plon, tape(t)%hlist(f)%nacs, fullnacs)
case (dyn_decomp)
if ( dycore_is('LR') )then
# if ( defined STAGGERED )
h3. NEW LR CODING
lenarr = plon[numlev]plat
if (tape(t)%hlist(f)%hbuf_prec == 8) then
select case (numlev)
case (1)
call fv_gather('2d', tape(t)%hlist(f)%hbuf%buf8, lenarr, 2, hbuf%buf8)
case (plev)
call fv_gather('3dxzy', tape(t)%hlist(f)%hbuf%buf8, lenarr, 3, hbuf%buf8)
case (plevp)
call fv_gather('3dxzyp', tape(t)%hlist(f)%hbuf%buf8, lenarr, 3, hbuf%buf8)
case default
write(6,*)'WRITE_RESTART_HISTORY: invalid number of levels=', numlev
call endrun ()
end select
else
select case (numlev)
case (1)
call fv_gather4('2d', tape(t)%hlist(f)%hbuf%buf4, lenarr, 2, hbuf%buf4)
case (plev)
call fv_gather4('3dxzy', tape(t)%hlist(f)%hbuf%buf4, lenarr, 3, hbuf%buf4)
case (plevp)
call fv_gather4('3dxzyp', tape(t)%hlist(f)%hbuf%buf4, lenarr, 3, hbuf%buf4)
case default
write(6,*)'WRITE_RESTART_HISTORY: invalid number of levels=', numlev
call endrun ()
end select
endif
call fv_gatheri('2d', tape(t)%hlist(f)%nacs, lenarr, 2, fullnacs)
# endif
else
numowned = coldimin*numlev
call compute_gsfactors (numowned, numsend, numrecv, displs)
call mpigatherv_hbuf (tape(t)%hlist(f)%hbuf, numsend, mpireal, hbuf, numrecv, &
displs, mpireal, 0, mpicom)
numowned = coldimin
call compute_gsfactors (numowned, numsend, numrecv, displs)
call mpigatherv (tape(t)%hlist(f)%nacs, numsend, mpiint, fullnacs, numrecv, &
displs, mpiint, 0, mpicom)
endif
end select
|
subroutine gather_chunk_to_field(fdim,mdim,ldim, &
nlond,localchunks,globalfield)
integer, intent(in) :: fdim ! declared length of first dimension
integer, intent(in) :: mdim ! declared length of middle dimension
integer, intent(in) :: ldim ! declared length of last dimension
integer, intent(in) :: nlond ! declared number of longitudes
real(r8), intent(in):: localchunks(fdim,pcols,mdim, &
begchunk:endchunk,ldim)
! local chunks
real(r8), intent(out) :: globalfield(fdim,nlond,mdim,plat,ldim)
! global field
|
subroutine fv_gather(decomp_type, arr, lenarr, ndim, bufres)
character(len=*) :: decomp_type
# if defined( SPMD )
real(r8) arr(*) ! Array to be gathered
# else
real(r8) arr(lenarr) ! Array (SMP-only)
# endif
integer lenarr ! Global length of array
integer ndim ! dimensionality (2 or 3) of array
real(r8), intent(out) :: bufres(*)
|
subroutine compute_gsfactors (numperlat, numtot, numperproc, displs)
integer, intent(in) :: numperlat ! number of elements per latitude
integer, intent(out) :: numtot ! total number of elements (to send or recv)
integer, intent(out) :: numperproc(0:npes-1) ! per-PE number of items to receive
integer, intent(out) :: displs(0:npes-1) ! per-PE displacements
subroutine mpigatherv_hbuf (hbuf_send, numsend, mpireal1, hbuf_recv, &
numrecv, displs, mpireal2, root, comm)
type (hbuffer_3d), intent(in ) :: hbuf_send ! send buffer
type (hbuffer_3d), intent(inout) :: hbuf_recv ! receive buffer
integer :: numsend ! number of items to be sent
integer :: mpireal1 ! MPI real data type for hbuf_send
integer :: mpireal2 ! MPI real data type for hbuf_recv
integer :: numrecv(*) ! number of items to be received
integer :: displs(*) ! displacement array
integer, intent(in) :: root
integer, intent(in) :: comm
|