Element-wise sum of data from all processes with result left only on one.
MPI mapping mpi_reduce
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_8), | intent(inout), | CONTIGUOUS | :: | msg(:) |
Vector to sum (input) and (only on process root) result (output) |
|
integer, | intent(in) | :: | root | |||
type(mp_comm_type), | intent(in) | :: | gid |
Message passing environment identifier |
SUBROUTINE mp_sum_root_dv(msg, root, gid) !! Element-wise sum of data from all processes with result left only on !! one. !! !! MPI mapping !! mpi_reduce REAL(kind=real_8), CONTIGUOUS, INTENT(INOUT) :: msg(:) !! Vector to sum (input) and (only on process root) result (output) INTEGER, INTENT(IN) :: root TYPE(mp_comm_type), INTENT(IN) :: gid !! Message passing environment identifier CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_sum_root_dv' INTEGER :: handle, ierr, msglen #if defined(__parallel) INTEGER :: m1, taskid REAL(kind=real_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) ALLOCATE (res(m1)) CALL mpi_reduce(msg, res, msglen, MPI_DOUBLE_PRECISION, 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*real_8_size) #else MARK_USED(root) MARK_USED(gid) #endif CALL timestop(handle) END SUBROUTINE mp_sum_root_dv