gather_block Subroutine

private subroutine gather_block(data_block, tmp)

Uses

Gather a chunk of data on node-root.

Arguments

Type IntentOptional Attributes Name
integer(kind=int64), intent(in) :: data_block(:)
integer(kind=int64), intent(out), allocatable :: tmp(:)

Source Code

    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