Gather real data to root node (for arrays of rank 2)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=dp), | intent(inout), | dimension(:, :) | :: | array | local array for sending data |
|
integer, | intent(in) | :: | localcount | localcount elements will be sent to the root node |
||
real(kind=dp), | intent(inout), | dimension(:, :) | :: | rootglobalarray | array on the root node to which data will be sent |
|
integer, | intent(in), | dimension(num_nodes) | :: | counts | how data should be partitioned, see MPI documentation or function comms_array_split |
|
integer, | intent(in), | dimension(num_nodes) | :: | displs |
subroutine comms_gatherv_real_2(array, localcount, rootglobalarray, counts, displs)
!! Gather real data to root node (for arrays of rank 2)
implicit none
real(kind=dp), dimension(:, :), intent(inout) :: array
!! local array for sending data
integer, intent(in) :: localcount
!! localcount elements will be sent to the root node
real(kind=dp), dimension(:, :), intent(inout) :: rootglobalarray
!! array on the root node to which data will be sent
integer, dimension(num_nodes), intent(in) :: counts
!! how data should be partitioned, see MPI documentation or
!! function comms_array_split
integer, dimension(num_nodes), intent(in) :: displs
#ifdef MPI
integer :: error
call MPI_gatherv(array, localcount, MPI_double_precision, rootglobalarray, counts, &
displs, MPI_double_precision, root_id, mpi_comm_world, error)
if (error .ne. MPI_success) then
call io_error('Error in comms_gatherv_real_2')
end if
#else
call dcopy(localcount, array, 1, rootglobalarray, 1)
#endif
return
end subroutine comms_gatherv_real_2