Element-wise sum of data from all processes with result left only on one.
Note
see mp_sum_root_lv
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=int_8), | intent(inout), | CONTIGUOUS | :: | msg(:,:) |
Matrix to sum (input) and (only on process root) result (output) |
|
integer, | intent(in) | :: | root | |||
type(mp_comm_type), | intent(in) | :: | gid |
SUBROUTINE mp_sum_root_lm(msg, root, gid) !! Element-wise sum of data from all processes with result left only on !! one. !! @note see mp_sum_root_lv INTEGER(KIND=int_8), CONTIGUOUS, INTENT(INOUT) :: msg(:, :) !! Matrix to sum (input) and (only on process root) result (output) INTEGER, INTENT(IN) :: root TYPE(mp_comm_type), INTENT(IN) :: gid CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_sum_root_rm' INTEGER :: handle, ierr, msglen #if defined(__parallel) INTEGER :: m1, m2, taskid INTEGER(KIND=int_8), ALLOCATABLE :: res(:, :) #endif ierr = 0 CALL timeset(routineN, handle) msglen = SIZE(msg) #if defined(__parallel) CALL mpi_comm_rank(gid%handle, taskid, ierr) IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_rank @ "//routineN) IF (msglen > 0) THEN m1 = SIZE(msg, 1) m2 = SIZE(msg, 2) ALLOCATE (res(m1, m2)) CALL mpi_reduce(msg, res, msglen, MPI_INTEGER8, MPI_SUM, root, gid%handle, ierr) IF (ierr /= 0) CALL mp_stop(ierr, "mpi_reduce @ "//routineN) IF (taskid == root) THEN msg = res END IF DEALLOCATE (res) END IF CALL add_perf(perf_id=3, msg_size=msglen*int_8_size) #else MARK_USED(root) MARK_USED(gid) #endif CALL timestop(handle) END SUBROUTINE mp_sum_root_lm