communicate_read_walkers_buff Function

private function communicate_read_walkers_buff(sendcounts, gdata_comm, gdata_loc) result(num_received)

Arguments

Type IntentOptional Attributes Name
integer(kind=MPIArg), intent(in) :: sendcounts(0:nProcessors-1)
integer(kind=hsize_t), intent(inout) :: gdata_comm(:,:)
integer(kind=hsize_t), intent(inout), allocatable :: gdata_loc(:,:)

Return Value integer


Contents


Source Code

    function communicate_read_walkers_buff(sendcounts, gdata_comm, &
                                           gdata_loc) result(num_received)
        integer(MPIArg), intent(in) :: sendcounts(0:nProcessors - 1)
        integer(hsize_t), intent(inout) :: gdata_comm(:, :)
        integer(hsize_t), allocatable, intent(inout) :: gdata_loc(:, :)
        integer :: num_received
        integer(int64) :: lnum_received

        integer(MPIArg) :: recvcounts(0:nProcessors - 1), recvcountsScaled(0:nProcessors - 1)
        integer(MPIArg) :: disps(0:nProcessors - 1), recvdisps(0:nProcessors - 1)
        integer(MPIArg) :: dispsScaled(0:nProcessors - 1), recvdispsScaled(0:nProcessors - 1)
        integer(MPIArg) :: sendcountsScaled(0:nProcessors - 1)
        integer :: j, ierr, gdata_size

        !offsets for data to the different procs
        disps(0) = 0
        do j = 1, nProcessors - 1
            disps(j) = disps(j - 1) + sendcounts(j - 1)
        end do

        ! Communicate the number of particles that need to go to each proc
        call MPIAllToAll(sendcounts, 1, recvcounts, 1, ierr)

        ! We want the data to be contiguous after the move. So calculate the
        ! offsets
        recvdisps(0) = 0
        do j = 1, nProcessors - 1
            recvdisps(j) = recvdisps(j - 1) + recvcounts(j - 1)
        end do
        num_received = recvdisps(nProcessors - 1) + recvcounts(nProcessors - 1)
        lnum_received = recvdisps(nProcessors - 1) + recvcounts(nProcessors - 1)
        gdata_size = size(gdata_loc, 1)
        ! Adjust offsets so that they match the size of the array
        call scaleCounts(size(SpawnedParts, 1))

        if (num_received > size(SpawnedParts2, 2)) then
            ! there could in principle be a memory problem because we are not limiting the
            ! size of receivebuff.
            write(stdout, *) 'Allocating additional buffer for communication on Processor ', iProcIndex, 'with ', &
                num_received * size(SpawnedParts, 1) * sizeof(SpawnedParts(1, 1)) / 1000000, 'MB'
            allocate(receivebuff(size(SpawnedParts, 1), num_received))
            call LogMemAlloc('receivebuff', size(receivebuff), int(sizeof(receivebuff(1, 1))), &
                             'communicate_read_walkers', receivebuff_tag, ierr)
            call MPIAllToAllV(SpawnedParts, sendcountsScaled, dispsScaled, receivebuff, &
                              recvcountsScaled, recvdispsScaled, ierr)

            ! gdata communication for auto-adaptive shift mode
            if (gdata_size > 0) then
                if (allocated(gdata_loc)) deallocate(gdata_loc)
                allocate(gdata_loc(gdata_size, num_received))
            end if
        else
            call MPIAllToAllV(SpawnedParts, sendcountsScaled, dispsScaled, SpawnedParts2, &
                              recvcountsScaled, recvdispsScaled, ierr)
        end if

        call scaleCounts(gdata_size)

        if (gdata_size > 0) then
            call MPIAllToAllV(gdata_comm, sendcountsScaled, dispsScaled, gdata_loc, &
                              recvcountsScaled, recvdispsScaled, ierr)
        end if

    contains

        subroutine scaleCounts(argSize)
            implicit none
            integer, intent(in) :: argSize

            recvcountsScaled = recvcounts * argSize
            recvdispsScaled = recvdisps * argSize
            sendcountsScaled = sendcounts * argSize
            dispsScaled = disps * argSize
        end subroutine scaleCounts
    end function communicate_read_walkers_buff