1!
2! Copyright (C) by Argonne National Laboratory
3!     See COPYRIGHT in top-level directory
4!
5
6subroutine MPI_Win_create_keyval_f08(win_copy_attr_fn, win_delete_attr_fn, win_keyval, &
7    extra_state, ierror)
8    use, intrinsic :: iso_c_binding, only : c_funloc
9    use, intrinsic :: iso_c_binding, only : c_int, c_funptr
10    use :: mpi_f08, only : MPI_ADDRESS_KIND
11    use :: mpi_f08, only : MPI_Win_copy_attr_function
12    use :: mpi_f08, only : MPI_Win_delete_attr_function
13    use :: mpi_c_interface, only : MPIR_Win_create_keyval_c
14    use :: mpi_c_interface, only : MPII_Keyval_set_proxy, MPIR_Win_copy_attr_f08_proxy, MPIR_Win_delete_attr_f08_proxy
15
16    implicit none
17
18    procedure(MPI_Win_copy_attr_function) :: win_copy_attr_fn
19    procedure(MPI_Win_delete_attr_function) :: win_delete_attr_fn
20    integer, intent(out) :: win_keyval
21    integer(MPI_ADDRESS_KIND), intent(in) :: extra_state
22    integer, optional, intent(out) :: ierror
23
24    type(c_funptr) :: win_copy_attr_fn_c
25    type(c_funptr) :: win_delete_attr_fn_c
26    integer(c_int) :: win_keyval_c
27    integer(c_int) :: ierror_c
28
29    win_copy_attr_fn_c = c_funloc(win_copy_attr_fn)
30    win_delete_attr_fn_c = c_funloc(win_delete_attr_fn)
31
32    ierror_c = MPIR_Win_create_keyval_c(win_copy_attr_fn_c, win_delete_attr_fn_c, win_keyval_c, extra_state)
33
34    call MPII_Keyval_set_proxy(win_keyval_c, c_funloc(MPIR_Win_copy_attr_f08_proxy), c_funloc(MPIR_Win_delete_attr_f08_proxy))
35    win_keyval = win_keyval_c
36    if (present(ierror)) ierror = ierror_c
37
38end subroutine MPI_Win_create_keyval_f08
39