1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Bsend_init_f08ts(buf, count, datatype, dest, tag, comm, request, 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, c_Request
10    use :: mpi_c_interface, only : MPIR_Bsend_init_cdesc
11
12    implicit none
13
14    type(*), dimension(..) :: 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    type(MPI_Request), intent(out) :: request
21    integer, optional, intent(out) :: ierror
22
23    integer(c_int) :: count_c
24    integer(c_int) :: dest_c
25    integer(c_int) :: tag_c
26    integer(c_Datatype) :: datatype_c
27    integer(c_Comm) :: comm_c
28    integer(c_Request) :: request_c
29    integer(c_int) :: ierror_c
30
31    if (c_int == kind(0)) then
32        ierror_c = MPIR_Bsend_init_cdesc(buf, count, datatype%MPI_VAL, dest, tag, comm%MPI_VAL, request%MPI_VAL)
33    else
34        count_c = count
35        datatype_c = datatype%MPI_VAL
36        dest_c = dest
37        tag_c = tag
38        comm_c = comm%MPI_VAL
39        ierror_c = MPIR_Bsend_init_cdesc(buf, count_c, datatype_c, dest_c, tag_c, comm_c, request_c)
40        request%MPI_VAL = request_c
41    end if
42
43    if (present(ierror)) ierror = ierror_c
44
45end subroutine PMPIR_Bsend_init_f08ts
46