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