1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Status_set_elements_x_f08(status, datatype, count, 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_Status, MPI_Datatype
10    use :: mpi_f08, only : MPI_COUNT_KIND
11    use :: mpi_f08, only : MPI_STATUS_IGNORE, MPIR_C_MPI_STATUS_IGNORE, assignment(=)
12    use :: mpi_c_interface, only : c_Datatype
13    use :: mpi_c_interface, only : c_Status
14    use :: mpi_c_interface, only : MPIR_Status_set_elements_x_c
15
16    implicit none
17
18    type(MPI_Status), intent(inout), target :: status
19    type(MPI_Datatype), intent(in) :: datatype
20    integer(MPI_COUNT_KIND), intent(in) :: count
21    integer, optional, intent(out) :: ierror
22
23    type(c_Status), target :: status_c
24    integer(c_Datatype) :: datatype_c
25    integer(MPI_COUNT_KIND) :: count_c
26    integer(c_int) :: ierror_c
27
28    if (c_int == kind(0)) then
29        if (c_associated(c_loc(status), c_loc(MPI_STATUS_IGNORE))) then
30            ierror_c = MPIR_Status_set_elements_x_c(MPIR_C_MPI_STATUS_IGNORE, datatype%MPI_VAL, count)
31        else
32            ierror_c = MPIR_Status_set_elements_x_c(c_loc(status), datatype%MPI_VAL, count)
33        end if
34    else
35        datatype_c = datatype%MPI_VAL
36        count_c = count
37        if (c_associated(c_loc(status), c_loc(MPI_STATUS_IGNORE))) then
38            ierror_c = MPIR_Status_set_elements_x_c(MPIR_C_MPI_STATUS_IGNORE, datatype_c, count_c)
39        else
40            ierror_c = MPIR_Status_set_elements_x_c(c_loc(status_c), datatype_c, count_c)
41            status = status_c
42        end if
43    end if
44
45    if (present(ierror)) ierror = ierror_c
46
47end subroutine PMPIR_Status_set_elements_x_f08
48