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!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
complex(kind=real_4), | CONTIGUOUS, DIMENSION(:) | :: | msgin |
Vector data to send |
||
integer, | intent(in) | :: | dest |
Which process to send to |
||
complex(kind=real_4), | CONTIGUOUS, DIMENSION(:) | :: | msgout |
Receive data into this pointer |
||
integer, | intent(in) | :: | source |
Process to receive from |
||
type(mp_comm_type), | intent(in) | :: | comm |
Message passing environment identifier |
||
type(mp_request_type), | intent(out) | :: | send_request |
Request handle for the send Request handle for the receive |
||
type(mp_request_type), | 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_cv(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! COMPLEX(kind=real_4), CONTIGUOUS, DIMENSION(:) :: msgin !! Vector data to send INTEGER, INTENT(IN) :: dest !! Which process to send to COMPLEX(kind=real_4), CONTIGUOUS, DIMENSION(:) :: msgout !! Receive data into this pointer INTEGER, INTENT(IN) :: source !! Process to receive from TYPE(mp_comm_type), INTENT(IN) :: comm !! Message passing environment identifier TYPE(mp_request_type), 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_cv' INTEGER :: handle, ierr #if defined(__parallel) INTEGER :: msglen, my_tag COMPLEX(kind=real_4) :: 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, msglen, MPI_COMPLEX, source, my_tag, & comm%handle, recv_request%handle, ierr) ELSE CALL mpi_irecv(foo, msglen, MPI_COMPLEX, source, my_tag, & comm%handle, recv_request%handle, 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, msglen, MPI_COMPLEX, dest, my_tag, & comm%handle, send_request%handle, ierr) ELSE CALL mpi_isend(foo, msglen, MPI_COMPLEX, dest, my_tag, & comm%handle, send_request%handle, 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*(2*real_4_size)) #else MARK_USED(dest) MARK_USED(source) MARK_USED(comm) MARK_USED(tag) send_request = mp_request_null recv_request = mp_request_null msgout = msgin #endif CALL timestop(handle) END SUBROUTINE mp_isendrecv_cv