1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Get_accumulate_f08ts(origin_addr, origin_count, origin_datatype, result_addr, &
7    result_count, result_datatype, target_rank, target_disp, &
8    target_count, target_datatype, op, win, ierror)
9    use, intrinsic :: iso_c_binding, only : c_int
10    use :: mpi_f08, only : MPI_Datatype, MPI_Op, MPI_Win
11    use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
12    use :: mpi_c_interface, only : c_Datatype, c_Op, c_Win
13    use :: mpi_c_interface, only : MPIR_Get_accumulate_cdesc
14
15    implicit none
16
17    type(*), dimension(..), intent(in), asynchronous :: origin_addr
18    type(*), dimension(..), asynchronous :: result_addr
19    integer, intent(in) :: origin_count
20    integer, intent(in) :: result_count
21    integer, intent(in) :: target_rank
22    integer, intent(in) :: target_count
23    type(MPI_Datatype), intent(in) :: origin_datatype
24    type(MPI_Datatype), intent(in) :: target_datatype
25    type(MPI_Datatype), intent(in) :: result_datatype
26    integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp
27    type(MPI_Op), intent(in) :: op
28    type(MPI_Win), intent(in) :: win
29    integer, optional, intent(out) :: ierror
30
31    integer(c_int) :: origin_count_c
32    integer(c_int) :: result_count_c
33    integer(c_int) :: target_rank_c
34    integer(c_int) :: target_count_c
35    integer(c_Datatype) :: origin_datatype_c
36    integer(c_Datatype) :: target_datatype_c
37    integer(c_Datatype) :: result_datatype_c
38    integer(c_Op) :: op_c
39    integer(c_Win) :: win_c
40    integer(c_int) :: ierror_c
41
42    if (c_int == kind(0)) then
43        ierror_c = MPIR_Get_accumulate_cdesc(origin_addr, origin_count, origin_datatype%MPI_VAL, result_addr, &
44            result_count, result_datatype%MPI_VAL, target_rank, target_disp, target_count, target_datatype%MPI_VAL, &
45            op%MPI_VAL, win%MPI_VAL)
46    else
47        origin_count_c = origin_count
48        origin_datatype_c = origin_datatype%MPI_VAL
49        result_count_c = result_count
50        result_datatype_c = result_datatype%MPI_VAL
51        target_rank_c = target_rank
52        target_count_c = target_count
53        target_datatype_c = target_datatype%MPI_VAL
54        op_c = op%MPI_VAL
55        win_c = win%MPI_VAL
56        ierror_c = MPIR_Get_accumulate_cdesc(origin_addr, origin_count_c, origin_datatype_c, result_addr, &
57            result_count_c, result_datatype_c, target_rank_c, target_disp, target_count_c, target_datatype_c, &
58            op_c, win_c)
59    end if
60
61    if (present(ierror)) ierror = ierror_c
62
63end subroutine PMPIR_Get_accumulate_f08ts
64