Skip to content

Commit

Permalink
Change mpi window allocation to use F08 interface
Browse files Browse the repository at this point in the history
  • Loading branch information
aradi committed Nov 17, 2023
1 parent fa41668 commit 15cc24d
Showing 1 changed file with 16 additions and 14 deletions.
30 changes: 16 additions & 14 deletions lib/mpifx_win.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,9 @@

!> Contains routined for MPI shared memory windows.
module mpifx_win_module
use mpifx_common_module
use mpi_f08
use mpifx_helper_module, only : handle_errorflag, sp, dp
use mpifx_comm_module, only : mpifx_comm
use mpifx_constants_module, only : MPIFX_SIZE_T
use iso_c_binding, only : c_ptr, c_f_pointer
implicit none
Expand All @@ -15,8 +17,8 @@ module mpifx_win_module
!> MPI shared memory window with some additional information.
type mpifx_win
private
integer, public :: id !< Window id.
integer :: comm_id !< Communicator id.
type(mpi_win) :: win !< MPI window handle.
type(mpi_comm) :: comm !< MPI communicator handle.
contains
!> Initializes an MPI shared memory window.
#:for TYPE in TYPES
Expand Down Expand Up @@ -89,17 +91,17 @@ contains
local_mem_size = int(global_length, kind=MPI_ADDRESS_KIND) * disp_unit
end if

call mpi_win_allocate_shared(local_mem_size, disp_unit, MPI_INFO_NULL, mycomm%id,&
& local_baseptr, self%id, error0)
self%comm%mpi_val = mycomm%id
call mpi_win_allocate_shared(local_mem_size, disp_unit, MPI_INFO_NULL, self%comm,&
& local_baseptr, self%win, error0)
call handle_errorflag(error0,&
& "MPI_WIN_ALLOCATE_SHARED in mpifx_win_allocate_shared_${SUFFIX}$", error)

call mpi_win_shared_query(self%id, mycomm%leadrank, global_mem_size, disp_unit, global_baseptr,&
& error1)
call mpi_win_shared_query(self%win, mycomm%leadrank, global_mem_size, disp_unit,&
& global_baseptr, error1)
call handle_errorflag(error1, "MPI_WIN_SHARED_QUERY in mpifx_win_allocate_shared_${SUFFIX}$",&
& error)

self%comm_id = mycomm%id
call c_f_pointer(global_baseptr, global_pointer, [global_length])
if (present(local_pointer)) then
call c_f_pointer(local_baseptr, local_pointer, [local_length])
Expand All @@ -122,7 +124,7 @@ contains

integer :: error0

call mpi_win_lock_all(MPI_MODE_NOCHECK, self%id, error0)
call mpi_win_lock_all(MPI_MODE_NOCHECK, self%win, error0)
call handle_errorflag(error0, "MPI_WIN_LOCK_ALL in mpifx_win_lock", error)

end subroutine mpifx_win_lock
Expand All @@ -141,7 +143,7 @@ contains

integer :: error0

call mpi_win_unlock_all(self%id, error0)
call mpi_win_unlock_all(self%win, error0)
call handle_errorflag(error0, "MPI_WIN_UNLOCK_ALL in mpifx_win_unlock", error)

end subroutine mpifx_win_unlock
Expand All @@ -161,10 +163,10 @@ contains

integer :: error0, error1

call mpi_win_sync(self%id, error0)
call mpi_win_sync(self%win, error0)
call handle_errorflag(error0, "MPI_WIN_SYNC in mpifx_win_sync", error)

call mpi_barrier(self%comm_id, error1)
call mpi_barrier(self%comm, error1)
call handle_errorflag(error1, "MPI_BARRIER in mpifx_win_sync", error)

end subroutine mpifx_win_sync
Expand All @@ -190,7 +192,7 @@ contains
assert_ = assert
end if

call mpi_win_fence(assert_, self%id, error0)
call mpi_win_fence(assert_, self%win, error0)
call handle_errorflag(error0, "MPI_WIN_FENCE in mpifx_win_fence", error)

end subroutine mpifx_win_fence
Expand All @@ -209,7 +211,7 @@ contains

integer :: error0

call mpi_win_free(self%id, error0)
call mpi_win_free(self%win, error0)
call handle_errorflag(error0, "MPI_WIN_FREE in mpifx_win_free", error)

end subroutine mpifx_win_free
Expand Down

0 comments on commit 15cc24d

Please sign in to comment.