1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Probe_f08(source, tag, comm, status, ierror)
7    use, intrinsic :: iso_c_binding, only : c_loc, c_associated
8    use, intrinsic :: iso_c_binding, only : c_int, c_ptr
9    use :: mpi_f08, only : MPI_Comm, MPI_Status
10    use :: mpi_f08, only : MPI_STATUS_IGNORE, MPIR_C_MPI_STATUS_IGNORE, assignment(=)
11    use :: mpi_c_interface, only : c_Comm
12    use :: mpi_c_interface, only : c_Status
13    use :: mpi_c_interface, only : MPIR_Probe_c
14
15    implicit none
16
17    integer, intent(in) :: source
18    integer, intent(in) :: tag
19    type(MPI_Comm), intent(in) :: comm
20    type(MPI_Status), target :: status
21    integer, optional, intent(out) :: ierror
22
23    integer(c_int) :: source_c
24    integer(c_int) :: tag_c
25    integer(c_Comm) :: comm_c
26    type(c_Status), target :: status_c
27    integer(c_int) :: ierror_c
28
29    if (c_int == kind(0)) then
30        if (c_associated(c_loc(status), c_loc(MPI_STATUS_IGNORE))) then
31            ierror_c = MPIR_Probe_c(source, tag, comm%MPI_VAL, MPIR_C_MPI_STATUS_IGNORE)
32        else
33            ierror_c = MPIR_Probe_c(source, tag, comm%MPI_VAL, c_loc(status))
34        end if
35    else
36        source_c = source
37        tag_c = tag
38        comm_c = comm%MPI_VAL
39        if (c_associated(c_loc(status), c_loc(MPI_STATUS_IGNORE))) then
40            ierror_c = MPIR_Probe_c(source_c, tag_c, comm_c, MPIR_C_MPI_STATUS_IGNORE)
41        else
42            ierror_c = MPIR_Probe_c(source_c, tag_c, comm_c, c_loc(status_c))
43            status = status_c
44        end if
45    end if
46
47    if (present(ierror)) ierror = ierror_c
48
49end subroutine PMPIR_Probe_f08
50