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 |
|||
integer, | 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
INTEGER, 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)
INTEGER, DIMENSION(mp_status_size) :: 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, status_single, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_probe @ "//routineN)
source = status_single(MPI_SOURCE)
tag = status_single(MPI_TAG)
ELSE
flag = .FALSE.
CALL mpi_iprobe(source, mp_any_tag, comm, 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_TAG) ! in case of flag==false status is undefined
ELSE
tag = status_single(MPI_TAG)
END IF
END IF
#else
tag = -1
MARK_USED(comm)
MARK_USED(source)
#endif
CALL timestop(handle)
END SUBROUTINE mp_probe