1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine PMPIR_Win_allocate_f08(size, disp_unit, info, comm, baseptr, win, ierror)
7    use, intrinsic :: iso_c_binding, only : c_int, c_ptr
8    use :: mpi_f08, only : MPI_Info, MPI_Comm, MPI_Win
9    use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
10    use :: mpi_c_interface, only : c_Info, c_Comm, c_Win
11    use :: mpi_c_interface, only : MPIR_Win_allocate_c
12
13    implicit none
14
15    integer(kind=MPI_ADDRESS_KIND), intent(in) :: size
16    integer, intent(in) :: disp_unit
17    type(MPI_Info), intent(in) :: info
18    type(MPI_Comm), intent(in) :: comm
19    type(c_ptr), intent(out) :: baseptr
20    type(MPI_Win), intent(out) :: win
21    integer, optional, intent(out) :: ierror
22
23    integer(c_int) :: disp_unit_c
24    integer(c_Info) :: info_c
25    integer(c_Comm) :: comm_c
26    type(c_ptr) :: baseptr_c
27    integer(c_Win) :: win_c
28    integer(c_int) :: ierror_c
29
30    if (c_int == kind(0)) then
31        ierror_c = MPIR_Win_allocate_c(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL)
32    else
33        disp_unit_c = disp_unit
34        info_c = info%MPI_VAL
35        comm_c = comm%MPI_VAL
36        ierror_c = MPIR_Win_allocate_c(size, disp_unit_c, info_c, comm_c, baseptr_c, win_c)
37        baseptr = baseptr_c
38        win%MPI_VAL = win_c
39    end if
40
41    if (present(ierror)) ierror = ierror_c
42
43end subroutine PMPIR_Win_allocate_f08
44