Gather a chunk of data on node-root. @param[in] data_block on each proc, the data from this proc to be gathered @param[out] tmp on return, on node-root the gathered data from all procs on this node, empty on all other procs. Guaranteed to be allocated on return (of size 0 on other than node-root).
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer(kind=int64), | intent(in) | :: | data_block(:) | |||
| integer(kind=int64), | intent(out), | allocatable | :: | tmp(:) |
subroutine gather_block(data_block, tmp)
integer(int64), intent(in) :: data_block(:)
integer(int64), allocatable, intent(out) :: tmp(:)
integer(MPIArg) :: procs_per_node
integer(MPIArg) :: this_block_size, total_size
integer(MPIArg), allocatable :: block_sizes(:), displs(:)
integer(MPIArg) :: ierr
integer :: i
call MPI_Comm_Size(mpi_comm_intra, procs_per_node, ierr)
allocate(block_sizes(0:procs_per_node - 1))
this_block_size = int(size(data_block), MPIArg)
! Check how much data was read in in total (needs to be known on node root)
call MPI_Gather(this_block_size, 1, MPI_INT, &
block_sizes, 1, MPI_INT, 0, mpi_comm_intra, ierr)
allocate(displs(0:procs_per_node - 1))
displs(0) = 0
do i = 1, procs_per_node - 1
displs(i) = displs(i - 1) + block_sizes(i - 1)
end do
total_size = sum(block_sizes)
if (iProcIndex_intra == 0) then
allocate(tmp(total_size))
else
allocate(tmp(0))
end if
! Gather all data on node-root
call MPI_GatherV(data_block, this_block_size, MPI_INTEGER8, &
tmp, block_sizes, displs, MPI_INTEGER8, 0, mpi_comm_intra, ierr)
deallocate(block_sizes)
deallocate(displs)
end subroutine gather_block