Gather a chunk of data on 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) use mpi_f08, only: MPI_INTEGER 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_INTEGER, & block_sizes, 1, MPI_INTEGER, 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