probes for an incoming message with any tag
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | source |
the source of the possible incoming message, if MP_ANY_SOURCE it is a blocking one and return value is the source of the next incoming message if source is a different value it is a non-blocking probe retuning MP_ANY_SOURCE if there is no incoming message |
|||
type(mp_comm_type), | intent(in) | :: | comm |
the communicator |
||
integer, | intent(out) | :: | tag |
the tag of the incoming message |
SUBROUTINE mp_probe(source, comm, tag) !! probes for an incoming message with any tag INTEGER :: source !! the source of the possible incoming message, if MP_ANY_SOURCE it is a blocking one and return value is the source of the !! next incoming message if source is a different value it is a non-blocking probe retuning MP_ANY_SOURCE if there is no !! incoming message TYPE(mp_comm_type), INTENT(IN) :: comm !! the communicator INTEGER, INTENT(OUT) :: tag !! the tag of the incoming message CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_probe' INTEGER :: handle, ierr #if defined(__parallel) MPI_STATUS_TYPE :: status_single LOGICAL :: flag #endif ! --------------------------------------------------------------------------- CALL timeset(routineN, handle) ierr = 0 #if defined(__parallel) IF (source .EQ. mp_any_source) THEN CALL mpi_probe(mp_any_source, mp_any_tag, comm%handle, status_single, ierr) IF (ierr /= 0) CALL mp_stop(ierr, "mpi_probe @ "//routineN) source = status_single MPI_STATUS_EXTRACT(MPI_SOURCE) tag = status_single MPI_STATUS_EXTRACT(MPI_TAG) ELSE flag = .FALSE. CALL mpi_iprobe(source, mp_any_tag, comm%handle, flag, status_single, ierr) IF (ierr /= 0) CALL mp_stop(ierr, "mpi_iprobe @ "//routineN) IF (flag .EQV. .FALSE.) THEN source = mp_any_source tag = -1 !status_single MPI_STATUS_EXTRACT(MPI_TAG) ! in case of flag==false status is undefined ELSE tag = status_single MPI_STATUS_EXTRACT(MPI_TAG) END IF END IF #else tag = -1 MARK_USED(comm) MARK_USED(source) #endif CALL timestop(handle) END SUBROUTINE mp_probe