gather_block Subroutine

private subroutine gather_block(data_block, tmp)

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 IntentOptional Attributes Name
integer(kind=int64), intent(in) :: data_block(:)
integer(kind=int64), intent(out), allocatable :: tmp(:)


Source Code

Source Code

    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
        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)

    end subroutine gather_block