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