1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Bsend_f08ts(buf, count, datatype, dest, tag, comm, ierror)
7    use, intrinsic :: iso_c_binding, only : c_int
8    use :: mpi_f08, only : MPI_Datatype, MPI_Comm, MPI_Request
9    use :: mpi_c_interface, only : c_Datatype, c_Comm
10    use :: mpi_c_interface, only : MPIR_Bsend_cdesc
11
12    implicit none
13
14    type(*), dimension(..), intent(in) :: buf
15    integer, intent(in) :: count
16    integer, intent(in) :: dest
17    integer, intent(in) :: tag
18    type(MPI_Datatype), intent(in) :: datatype
19    type(MPI_Comm), intent(in) :: comm
20    integer, optional, intent(out) :: ierror
21
22    integer(c_int) :: count_c
23    integer(c_int) :: dest_c
24    integer(c_int) :: tag_c
25    integer(c_Datatype) :: datatype_c
26    integer(c_Comm) :: comm_c
27    integer(c_int) :: ierror_c
28
29    if (c_int == kind(0)) then
30        ierror_c = MPIR_Bsend_cdesc(buf, count, datatype%MPI_VAL, dest, tag, comm%MPI_VAL)
31    else
32        count_c = count
33        datatype_c = datatype%MPI_VAL
34        dest_c = dest
35        tag_c = tag
36        comm_c = comm%MPI_VAL
37        ierror_c = MPIR_Bsend_cdesc(buf, count_c, datatype_c, dest_c, tag_c, comm_c)
38    end if
39
40    if (present(ierror)) ierror = ierror_c
41
42end subroutine PMPIR_Bsend_f08ts
43