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