1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine MPI_Fetch_and_op_f08ts(origin_addr, result_addr, datatype, target_rank, &
7    target_disp, op, win, ierror)
8    use, intrinsic :: iso_c_binding, only : c_int
9    use :: mpi_f08, only : MPI_Datatype, MPI_Op, MPI_Win
10    use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
11    use :: mpi_c_interface, only : c_Datatype, c_Op, c_Win
12    use :: mpi_c_interface, only : MPIR_Fetch_and_op_cdesc
13
14    implicit none
15
16    type(*), dimension(..), intent(in), asynchronous :: origin_addr
17    type(*), dimension(..), asynchronous :: result_addr
18    type(MPI_Datatype), intent(in) :: datatype
19    integer, intent(in) :: target_rank
20    integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp
21    type(MPI_Op), intent(in) :: op
22    type(MPI_Win), intent(in) :: win
23    integer, optional, intent(out) :: ierror
24
25    integer(c_Datatype) :: datatype_c
26    integer(c_int) :: target_rank_c
27    integer(c_Op) :: op_c
28    integer(c_Win) :: win_c
29    integer(c_int) :: ierror_c
30
31    if (c_int == kind(0)) then
32        ierror_c = MPIR_Fetch_and_op_cdesc(origin_addr, result_addr, datatype%MPI_VAL, target_rank, target_disp, &
33            op%MPI_VAL, win%MPI_VAL)
34    else
35        datatype_c = datatype%MPI_VAL
36        target_rank_c = target_rank
37        op_c = op%MPI_VAL
38        win_c = win%MPI_VAL
39        ierror_c = MPIR_Fetch_and_op_cdesc(origin_addr, result_addr, datatype_c, target_rank_c, target_disp, &
40            op_c, win_c)
41    end if
42
43    if (present(ierror)) ierror = ierror_c
44
45end subroutine MPI_Fetch_and_op_f08ts
46