Non-blocking send and receive of a vector
Implementation Calls mpi_isend and mpi_irecv.
arrays can be pointers or assumed shape, but they must be contiguous!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real_8), | CONTIGUOUS, DIMENSION(:) | :: | msgin |
Vector data to send |
||
integer, | intent(in) | :: | dest |
Which process to send to |
||
real(kind=real_8), | CONTIGUOUS, DIMENSION(:) | :: | msgout |
Receive data into this pointer |
||
integer, | intent(in) | :: | source |
Process to receive from Message passing environment identifier |
||
integer, | intent(in) | :: | comm |
Process to receive from Message passing environment identifier |
||
integer, | intent(out) | :: | send_request |
Request handle for the send Request handle for the receive |
||
integer, | intent(out) | :: | recv_request |
Request handle for the send Request handle for the receive |
||
integer, | intent(in), | optional | :: | tag |
tag to differentiate requests |
SUBROUTINE mp_isendrecv_dv(msgin, dest, msgout, source, comm, send_request, &
recv_request, tag)
!! Non-blocking send and receive of a vector
!!
!! Implementation
!! Calls mpi_isend and mpi_irecv.
!! @note
!! arrays can be pointers or assumed shape, but they must be contiguous!
REAL(kind=real_8), CONTIGUOUS, DIMENSION(:) :: msgin
!! Vector data to send
INTEGER, INTENT(IN) :: dest
!! Which process to send to
REAL(kind=real_8), CONTIGUOUS, DIMENSION(:) :: msgout
!! Receive data into this pointer
INTEGER, INTENT(IN) :: source, comm
!! Process to receive from
!! Message passing environment identifier
INTEGER, INTENT(out) :: send_request, recv_request
!! Request handle for the send
!! Request handle for the receive
INTEGER, INTENT(in), OPTIONAL :: tag
!! tag to differentiate requests
CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_isendrecv_dv'
INTEGER :: handle, ierr
#if defined(__parallel)
INTEGER :: msglen, my_tag
REAL(kind=real_8) :: foo
#endif
ierr = 0
CALL timeset(routineN, handle)
#if defined(__parallel)
my_tag = 0
IF (PRESENT(tag)) my_tag = tag
msglen = SIZE(msgout, 1)
IF (msglen > 0) THEN
CALL mpi_irecv(msgout(1), msglen, MPI_DOUBLE_PRECISION, source, my_tag, &
comm, recv_request, ierr)
ELSE
CALL mpi_irecv(foo, msglen, MPI_DOUBLE_PRECISION, source, my_tag, &
comm, recv_request, ierr)
END IF
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_irecv @ "//routineN)
msglen = SIZE(msgin, 1)
IF (msglen > 0) THEN
CALL mpi_isend(msgin(1), msglen, MPI_DOUBLE_PRECISION, dest, my_tag, &
comm, send_request, ierr)
ELSE
CALL mpi_isend(foo, msglen, MPI_DOUBLE_PRECISION, dest, my_tag, &
comm, send_request, ierr)
END IF
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_isend @ "//routineN)
msglen = (msglen + SIZE(msgout, 1) + 1)/2
CALL add_perf(perf_id=8, msg_size=msglen*real_8_size)
#else
MARK_USED(dest)
MARK_USED(source)
MARK_USED(comm)
MARK_USED(tag)
send_request = 0
recv_request = 0
msgout = msgin
#endif
CALL timestop(handle)
END SUBROUTINE mp_isendrecv_dv