Element-wise sum of a rank-2 array on all processes.
Note
see mp_sum_c
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
complex(kind=real_4), | intent(inout), | CONTIGUOUS | :: | msg(:,:) |
Matrix to sum and result |
|
type(mp_comm_type), | intent(in) | :: | gid |
SUBROUTINE mp_sum_cm(msg, gid) !! Element-wise sum of a rank-2 array on all processes. !! @note see mp_sum_c COMPLEX(kind=real_4), CONTIGUOUS, INTENT(INOUT) :: msg(:, :) !! Matrix to sum and result TYPE(mp_comm_type), INTENT(IN) :: gid CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_sum_cm' INTEGER :: handle, ierr #if defined(__parallel) INTEGER, PARAMETER :: max_msg = 2**25 INTEGER :: m1, msglen, step, msglensum #endif ierr = 0 CALL timeset(routineN, handle) #if defined(__parallel) ! chunk up the call so that message sizes are limited, to avoid overflows in mpich triggered in large rpa calcs step = MAX(1, SIZE(msg, 2)/MAX(1, SIZE(msg)/max_msg)) msglensum = 0 DO m1 = LBOUND(msg, 2), UBOUND(msg, 2), step msglen = SIZE(msg, 1)*(MIN(UBOUND(msg, 2), m1 + step - 1) - m1 + 1) msglensum = msglensum + msglen IF (msglen > 0) THEN CALL mpi_allreduce(MPI_IN_PLACE, msg(LBOUND(msg, 1), m1), msglen, MPI_COMPLEX, MPI_SUM, gid%handle, ierr) IF (ierr /= 0) CALL mp_stop(ierr, "mpi_allreduce @ "//routineN) END IF END DO CALL add_perf(perf_id=3, msg_size=msglensum*(2*real_4_size)) #else MARK_USED(msg) MARK_USED(gid) #endif CALL timestop(handle) END SUBROUTINE mp_sum_cm