From e6be7389c9da0e1eb0126faf06044eaee5a11cc9 Mon Sep 17 00:00:00 2001
From: Tobias Melson <tobias.melson@mpcdf.mpg.de>
Date: Mon, 21 Feb 2022 16:16:07 +0100
Subject: [PATCH 1/5] Introduced routines for MPI shared memory

MPI shared memory is a concept for allocating memory accessibly by ranks
that are connected to the same physical memory, i.e. on the same node in
a cluster. In this basic implementation here, we can use this concept to
reduce the memory usage of an application if large arrays are stored
only once per node and not once per MPI task.

See test/test_shared_memory.f90 for a short example.
---
 lib/CMakeLists.txt          |   3 +-
 lib/module.fpp              |   1 +
 lib/mpifx_shared_memory.fpp | 150 ++++++++++++++++++++++++++++++++++++
 test/CMakeLists.txt         |   3 +-
 test/meson.build            |   1 +
 test/test_shared_memory.f90 |  34 ++++++++
 6 files changed, 190 insertions(+), 2 deletions(-)
 create mode 100644 lib/mpifx_shared_memory.fpp
 create mode 100644 test/test_shared_memory.f90

diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt
index b5250a0..43c83aa 100644
--- a/lib/CMakeLists.txt
+++ b/lib/CMakeLists.txt
@@ -19,7 +19,8 @@ set(sources-fpp
   mpifx_reduce.fpp
   mpifx_scatter.fpp
   mpifx_scatterv.fpp
-  mpifx_send.fpp)
+  mpifx_send.fpp
+  mpifx_shared_memory.fpp)
 
 fypp_preprocess("${sources-fpp}" sources-f90)
 
diff --git a/lib/module.fpp b/lib/module.fpp
index a121129..7e4cec4 100644
--- a/lib/module.fpp
+++ b/lib/module.fpp
@@ -30,6 +30,7 @@ module libmpifx_module
   use mpifx_allgatherv_module
   use mpifx_scatter_module
   use mpifx_scatterv_module
+  use mpifx_shared_memory_module
   implicit none
   public
 
diff --git a/lib/mpifx_shared_memory.fpp b/lib/mpifx_shared_memory.fpp
new file mode 100644
index 0000000..2948669
--- /dev/null
+++ b/lib/mpifx_shared_memory.fpp
@@ -0,0 +1,150 @@
+#:include 'mpifx.fypp'
+#:set TYPES = NUMERIC_TYPES
+
+!> Contains utilities for handling MPI shared memory
+module mpifx_shared_memory_module
+  use mpifx_common_module
+  use iso_c_binding, only : c_ptr, c_f_pointer
+  implicit none
+  private
+
+  public :: mpifx_allocate_shared, mpifx_free_shared, mpifx_lock_shared, mpifx_unlock_shared, mpifx_sync_shared
+
+  interface mpifx_allocate_shared
+#:for TYPE in TYPES
+  #:set TYPEABBREV = TYPE_ABBREVS[TYPE]
+  module procedure mpifx_allocate_shared_${TYPEABBREV}$
+#:endfor
+  end interface mpifx_allocate_shared
+
+contains
+
+#:def mpifx_allocate_shared_template(SUFFIX, TYPE)
+
+  !> Returns a window handle and a pointer to the address associated with a shared memory segment.
+  !!
+  !! \param mycomm  MPI communicator.
+  !! \param length  Number of elements of type ${TYPE}$ in the shared memory window.
+  !! \param win  Handle of the shared memory window on return.
+  !! \param shared_data  Pointer to the shared data array of length 'length' on return.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_ALLOCATE_SHARED)
+  !!
+  subroutine mpifx_allocate_shared_${SUFFIX}$(mycomm, length, win, shared_data, error)
+    type(mpifx_comm), intent(in) :: mycomm
+    integer, intent(in) :: length
+    integer, intent(out) :: win
+    ${TYPE}$, pointer, intent(out) :: shared_data(:)
+    integer, intent(out), optional :: error
+
+    integer :: disp_unit, error0, error1
+    integer(MPI_ADDRESS_KIND) :: local_length
+    type(c_ptr) :: baseptr
+
+    disp_unit = kind(shared_data)
+
+    local_length = 0
+    if (mycomm%lead) then
+      local_length = length * disp_unit
+    end if
+
+    call mpi_win_allocate_shared(local_length, disp_unit, MPI_INFO_NULL, mycomm%id, baseptr, win, error0)
+    call handle_errorflag(error0, "MPI_WIN_ALLOCATE_SHARED in mpifx_allocate_shared_${SUFFIX}$", error)
+
+    call mpi_win_shared_query(win, 0, local_length, disp_unit, baseptr, error1)
+    call handle_errorflag(error1, "MPI_WIN_SHARED_QUERY in mpifx_allocate_shared_${SUFFIX}$", error)
+
+    call c_f_pointer(baseptr, shared_data, [length])
+
+  end subroutine mpifx_allocate_shared_${SUFFIX}$
+
+#:enddef mpifx_allocate_shared_template
+
+  !> Deallocates a memory associated with a shared memory segment.
+  !!
+  !! \param win  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_FREE)
+  !!
+  subroutine mpifx_free_shared(win, error)
+    integer, intent(inout) :: win
+    integer, intent(out), optional :: error
+
+    integer :: error0
+
+    call mpi_win_free(win, error0)
+    call handle_errorflag(error0, "MPI_WIN_FREE in mpifx_free_shared", error)
+
+  end subroutine mpifx_free_shared
+
+  !> Locks a shared memory segment.
+  !!
+  !! \param win  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_LOCK_ALL)
+  !!
+  subroutine mpifx_lock_shared(win, error)
+    integer, intent(inout) :: win
+    integer, intent(out), optional :: error
+
+    integer :: error0
+
+    call mpi_win_lock_all(MPI_MODE_NOCHECK, win, error0)
+    call handle_errorflag(error0, "MPI_WIN_LOCK_ALL in mpifx_lock_shared", error)
+
+  end subroutine mpifx_lock_shared
+
+  !> Unlocks a shared memory segment.
+  !!
+  !! \param win  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_UNLOCK_ALL)
+  !!
+  subroutine mpifx_unlock_shared(win, error)
+    integer, intent(inout) :: win
+    integer, intent(out), optional :: error
+
+    integer :: error0
+
+    call mpi_win_unlock_all(win, error0)
+    call handle_errorflag(error0, "MPI_WIN_UNLOCK_ALL in mpifx_unlock_shared", error)
+
+  end subroutine mpifx_unlock_shared
+
+  !> Synchronizes shared memory across MPI ranks.
+  !!
+  !! \param mycomm  MPI communicator.
+  !! \param win  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_SYNC)
+  !!
+  subroutine mpifx_sync_shared(mycomm, win, error)
+    type(mpifx_comm), intent(in) :: mycomm
+    integer, intent(inout) :: win
+    integer, intent(out), optional :: error
+
+    integer :: error0, error1
+
+    call mpi_win_sync(win, error0)
+    call handle_errorflag(error0, "MPI_WIN_SYNC in mpifx_sync_shared", error)
+
+    call mpi_barrier(mycomm%id, error1)
+    call handle_errorflag(error1, "MPI_BARRIER in mpifx_sync_shared", error)
+
+  end subroutine mpifx_sync_shared
+
+
+#:for TYPE in TYPES
+  #:set FTYPE = FORTRAN_TYPES[TYPE]
+  #:set SUFFIX = TYPE_ABBREVS[TYPE]
+
+  $:mpifx_allocate_shared_template(SUFFIX, FTYPE)
+
+#:endfor
+
+end module mpifx_shared_memory_module
diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt
index 29760dd..0be19fc 100644
--- a/test/CMakeLists.txt
+++ b/test/CMakeLists.txt
@@ -9,7 +9,8 @@ set(targets
   test_gatherv
   test_reduce
   test_scatter
-  test_scatterv)
+  test_scatterv
+  test_shared_memory)
 
 foreach(target IN LISTS targets)
   add_executable(${target} ${target}.f90)
diff --git a/test/meson.build b/test/meson.build
index cbfc239..04fc3bb 100644
--- a/test/meson.build
+++ b/test/meson.build
@@ -12,6 +12,7 @@ tests = [
   'reduce',
   'scatter',
   'scatterv',
+  'shared_memory',
 ]
 
 foreach t : tests
diff --git a/test/test_shared_memory.f90 b/test/test_shared_memory.f90
new file mode 100644
index 0000000..ebce3cc
--- /dev/null
+++ b/test/test_shared_memory.f90
@@ -0,0 +1,34 @@
+program test_shared_memory
+  use libmpifx_module
+  implicit none
+
+  type(mpifx_comm) :: globalcomm, nodecomm
+  integer, parameter :: length = 7
+  integer :: win
+  integer, pointer :: data_pointer(:)
+
+  call mpifx_init()
+  call globalcomm%init()
+
+  ! Create a new communicator for all ranks on a node first
+  call globalcomm%split_type(MPI_COMM_TYPE_SHARED, globalcomm%rank, nodecomm)
+
+  call mpifx_allocate_shared(nodecomm, length, win, data_pointer)
+
+  call mpifx_lock_shared(win)
+
+  ! Only rank 0 writes data into the array
+  if (nodecomm%lead) then
+    data_pointer(:) = 42
+  end if
+
+  call mpifx_sync_shared(nodecomm, win)
+  call mpifx_unlock_shared(win)
+
+  ! All ranks on the node will read the same value
+  write(*, "(2(A,1X,I0,1X))") "ID:", nodecomm%rank, "VALUE:", data_pointer(1)
+
+  call mpifx_free_shared(win)
+  call mpifx_finalize()
+
+end program test_shared_memory

From d104cd863338f753824f8c2e774c4aac58271625 Mon Sep 17 00:00:00 2001
From: Tobias Melson <tobias.melson@mpcdf.mpg.de>
Date: Wed, 23 Feb 2022 14:09:54 +0100
Subject: [PATCH 2/5] Created win type with shared memory functionality

The new type mpifx_win can now be used to handle MPI shared memory
conveniently.
---
 lib/CMakeLists.txt                            |   2 +-
 lib/meson.build                               |   1 +
 lib/module.fpp                                |   2 +-
 lib/mpifx_shared_memory.fpp                   | 150 ---------------
 lib/mpifx_win.fpp                             | 172 ++++++++++++++++++
 test/CMakeLists.txt                           |   2 +-
 test/meson.build                              |   2 +-
 ...red_memory.f90 => test_win_shared_mem.f90} |  16 +-
 8 files changed, 185 insertions(+), 162 deletions(-)
 delete mode 100644 lib/mpifx_shared_memory.fpp
 create mode 100644 lib/mpifx_win.fpp
 rename test/{test_shared_memory.f90 => test_win_shared_mem.f90} (68%)

diff --git a/lib/CMakeLists.txt b/lib/CMakeLists.txt
index 43c83aa..0cdf659 100644
--- a/lib/CMakeLists.txt
+++ b/lib/CMakeLists.txt
@@ -20,7 +20,7 @@ set(sources-fpp
   mpifx_scatter.fpp
   mpifx_scatterv.fpp
   mpifx_send.fpp
-  mpifx_shared_memory.fpp)
+  mpifx_win.fpp)
 
 fypp_preprocess("${sources-fpp}" sources-f90)
 
diff --git a/lib/meson.build b/lib/meson.build
index db50325..c590372 100644
--- a/lib/meson.build
+++ b/lib/meson.build
@@ -22,6 +22,7 @@ sources_fpp = files(
   'mpifx_scatter.fpp',
   'mpifx_scatterv.fpp',
   'mpifx_send.fpp',
+  'mpifx_win.fpp',
 )
 sources_f90 = []
 foreach src : sources_fpp
diff --git a/lib/module.fpp b/lib/module.fpp
index 7e4cec4..a605e24 100644
--- a/lib/module.fpp
+++ b/lib/module.fpp
@@ -30,7 +30,7 @@ module libmpifx_module
   use mpifx_allgatherv_module
   use mpifx_scatter_module
   use mpifx_scatterv_module
-  use mpifx_shared_memory_module
+  use mpifx_win_module
   implicit none
   public
 
diff --git a/lib/mpifx_shared_memory.fpp b/lib/mpifx_shared_memory.fpp
deleted file mode 100644
index 2948669..0000000
--- a/lib/mpifx_shared_memory.fpp
+++ /dev/null
@@ -1,150 +0,0 @@
-#:include 'mpifx.fypp'
-#:set TYPES = NUMERIC_TYPES
-
-!> Contains utilities for handling MPI shared memory
-module mpifx_shared_memory_module
-  use mpifx_common_module
-  use iso_c_binding, only : c_ptr, c_f_pointer
-  implicit none
-  private
-
-  public :: mpifx_allocate_shared, mpifx_free_shared, mpifx_lock_shared, mpifx_unlock_shared, mpifx_sync_shared
-
-  interface mpifx_allocate_shared
-#:for TYPE in TYPES
-  #:set TYPEABBREV = TYPE_ABBREVS[TYPE]
-  module procedure mpifx_allocate_shared_${TYPEABBREV}$
-#:endfor
-  end interface mpifx_allocate_shared
-
-contains
-
-#:def mpifx_allocate_shared_template(SUFFIX, TYPE)
-
-  !> Returns a window handle and a pointer to the address associated with a shared memory segment.
-  !!
-  !! \param mycomm  MPI communicator.
-  !! \param length  Number of elements of type ${TYPE}$ in the shared memory window.
-  !! \param win  Handle of the shared memory window on return.
-  !! \param shared_data  Pointer to the shared data array of length 'length' on return.
-  !! \param error  Optional error code on return.
-  !!
-  !! \see MPI documentation (\c MPI_WIN_ALLOCATE_SHARED)
-  !!
-  subroutine mpifx_allocate_shared_${SUFFIX}$(mycomm, length, win, shared_data, error)
-    type(mpifx_comm), intent(in) :: mycomm
-    integer, intent(in) :: length
-    integer, intent(out) :: win
-    ${TYPE}$, pointer, intent(out) :: shared_data(:)
-    integer, intent(out), optional :: error
-
-    integer :: disp_unit, error0, error1
-    integer(MPI_ADDRESS_KIND) :: local_length
-    type(c_ptr) :: baseptr
-
-    disp_unit = kind(shared_data)
-
-    local_length = 0
-    if (mycomm%lead) then
-      local_length = length * disp_unit
-    end if
-
-    call mpi_win_allocate_shared(local_length, disp_unit, MPI_INFO_NULL, mycomm%id, baseptr, win, error0)
-    call handle_errorflag(error0, "MPI_WIN_ALLOCATE_SHARED in mpifx_allocate_shared_${SUFFIX}$", error)
-
-    call mpi_win_shared_query(win, 0, local_length, disp_unit, baseptr, error1)
-    call handle_errorflag(error1, "MPI_WIN_SHARED_QUERY in mpifx_allocate_shared_${SUFFIX}$", error)
-
-    call c_f_pointer(baseptr, shared_data, [length])
-
-  end subroutine mpifx_allocate_shared_${SUFFIX}$
-
-#:enddef mpifx_allocate_shared_template
-
-  !> Deallocates a memory associated with a shared memory segment.
-  !!
-  !! \param win  Handle of the shared memory window.
-  !! \param error  Optional error code on return.
-  !!
-  !! \see MPI documentation (\c MPI_WIN_FREE)
-  !!
-  subroutine mpifx_free_shared(win, error)
-    integer, intent(inout) :: win
-    integer, intent(out), optional :: error
-
-    integer :: error0
-
-    call mpi_win_free(win, error0)
-    call handle_errorflag(error0, "MPI_WIN_FREE in mpifx_free_shared", error)
-
-  end subroutine mpifx_free_shared
-
-  !> Locks a shared memory segment.
-  !!
-  !! \param win  Handle of the shared memory window.
-  !! \param error  Optional error code on return.
-  !!
-  !! \see MPI documentation (\c MPI_WIN_LOCK_ALL)
-  !!
-  subroutine mpifx_lock_shared(win, error)
-    integer, intent(inout) :: win
-    integer, intent(out), optional :: error
-
-    integer :: error0
-
-    call mpi_win_lock_all(MPI_MODE_NOCHECK, win, error0)
-    call handle_errorflag(error0, "MPI_WIN_LOCK_ALL in mpifx_lock_shared", error)
-
-  end subroutine mpifx_lock_shared
-
-  !> Unlocks a shared memory segment.
-  !!
-  !! \param win  Handle of the shared memory window.
-  !! \param error  Optional error code on return.
-  !!
-  !! \see MPI documentation (\c MPI_WIN_UNLOCK_ALL)
-  !!
-  subroutine mpifx_unlock_shared(win, error)
-    integer, intent(inout) :: win
-    integer, intent(out), optional :: error
-
-    integer :: error0
-
-    call mpi_win_unlock_all(win, error0)
-    call handle_errorflag(error0, "MPI_WIN_UNLOCK_ALL in mpifx_unlock_shared", error)
-
-  end subroutine mpifx_unlock_shared
-
-  !> Synchronizes shared memory across MPI ranks.
-  !!
-  !! \param mycomm  MPI communicator.
-  !! \param win  Handle of the shared memory window.
-  !! \param error  Optional error code on return.
-  !!
-  !! \see MPI documentation (\c MPI_WIN_SYNC)
-  !!
-  subroutine mpifx_sync_shared(mycomm, win, error)
-    type(mpifx_comm), intent(in) :: mycomm
-    integer, intent(inout) :: win
-    integer, intent(out), optional :: error
-
-    integer :: error0, error1
-
-    call mpi_win_sync(win, error0)
-    call handle_errorflag(error0, "MPI_WIN_SYNC in mpifx_sync_shared", error)
-
-    call mpi_barrier(mycomm%id, error1)
-    call handle_errorflag(error1, "MPI_BARRIER in mpifx_sync_shared", error)
-
-  end subroutine mpifx_sync_shared
-
-
-#:for TYPE in TYPES
-  #:set FTYPE = FORTRAN_TYPES[TYPE]
-  #:set SUFFIX = TYPE_ABBREVS[TYPE]
-
-  $:mpifx_allocate_shared_template(SUFFIX, FTYPE)
-
-#:endfor
-
-end module mpifx_shared_memory_module
diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp
new file mode 100644
index 0000000..2d9ece3
--- /dev/null
+++ b/lib/mpifx_win.fpp
@@ -0,0 +1,172 @@
+#:include 'mpifx.fypp'
+#:set TYPES = NUMERIC_TYPES
+
+!> Contains routined for MPI shared memory.
+module mpifx_win_module
+  use mpifx_common_module
+  use iso_c_binding, only : c_ptr, c_f_pointer
+  implicit none
+  private
+
+  public :: mpifx_win
+
+  !> MPI shared memory window with some additional information.
+  type mpifx_win
+    integer :: id       !< Window id.
+    integer :: comm_id  !< Communicator id.
+  contains
+    !> Initializes an MPI shared memory window.
+    generic :: allocate_shared => &
+#:for TYPE in TYPES[:-1]
+    & mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$,&
+#:endfor
+    & mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPES[-1]]}$
+
+#:for TYPE in TYPES
+    procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$
+#:endfor
+
+    !> Locks a shared memory segment.
+    procedure :: lock => mpifx_win_lock
+
+    !> Unlocks a shared memory segment.
+    procedure :: unlock => mpifx_win_unlock
+
+    !> Synchronizes shared memory across MPI ranks.
+    procedure :: sync => mpifx_win_sync
+
+    !> Deallocates memory associated with a shared memory segment.
+    procedure :: free => mpifx_win_free
+
+  end type mpifx_win
+
+contains
+
+#:def mpifx_win_allocate_shared_template(SUFFIX, TYPE)
+
+  !> Initialized a window handle and returns a pointer to the address associated with a shared memory segment.
+  !!
+  !! \param self  Handle of the shared memory window on return.
+  !! \param mycomm  MPI communicator.
+  !! \param length  Number of elements of type ${TYPE}$ in the shared memory window.
+  !! \param shared_data  Pointer to the shared data array of length 'length' on return.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_ALLOCATE_SHARED)
+  !!
+  subroutine mpifx_win_allocate_shared_${SUFFIX}$(self, mycomm, length, shared_data, error)
+    class(mpifx_win), intent(out) :: self
+    class(mpifx_comm), intent(in) :: mycomm
+    integer, intent(in) :: length
+    ${TYPE}$, pointer, intent(out) :: shared_data(:)
+    integer, intent(out), optional :: error
+
+    integer :: disp_unit, error0, error1
+    integer(MPI_ADDRESS_KIND) :: local_length
+    type(c_ptr) :: baseptr
+
+    disp_unit = kind(shared_data)
+
+    local_length = 0
+    if (mycomm%lead) then
+      local_length = length * disp_unit
+    end if
+
+    call mpi_win_allocate_shared(local_length, disp_unit, MPI_INFO_NULL, mycomm%id, baseptr, self%id, error0)
+    call handle_errorflag(error0, "MPI_WIN_ALLOCATE_SHARED in mpifx_win_allocate_shared_${SUFFIX}$", error)
+
+    call mpi_win_shared_query(self%id, 0, local_length, disp_unit, 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(baseptr, shared_data, [length])
+
+  end subroutine mpifx_win_allocate_shared_${SUFFIX}$
+
+#:enddef mpifx_win_allocate_shared_template
+
+  !> Locks a shared memory segment.
+  !!
+  !! \param self  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_LOCK_ALL)
+  !!
+  subroutine mpifx_win_lock(self, error)
+    class(mpifx_win), intent(inout) :: self
+    integer, intent(out), optional :: error
+
+    integer :: error0
+
+    call mpi_win_lock_all(MPI_MODE_NOCHECK, self%id, error0)
+    call handle_errorflag(error0, "MPI_WIN_LOCK_ALL in mpifx_win_lock", error)
+
+  end subroutine mpifx_win_lock
+
+  !> Unlocks a shared memory segment.
+  !!
+  !! \param self  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_UNLOCK_ALL)
+  !!
+  subroutine mpifx_win_unlock(self, error)
+    class(mpifx_win), intent(inout) :: self
+    integer, intent(out), optional :: error
+
+    integer :: error0
+
+    call mpi_win_unlock_all(self%id, error0)
+    call handle_errorflag(error0, "MPI_WIN_UNLOCK_ALL in mpifx_win_unlock", error)
+
+  end subroutine mpifx_win_unlock
+
+  !> Synchronizes shared memory across MPI ranks.
+  !!
+  !! \param self  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_SYNC)
+  !!
+  subroutine mpifx_win_sync(self, error)
+    class(mpifx_win), intent(inout) :: self
+    integer, intent(out), optional :: error
+
+    integer :: error0, error1
+
+    call mpi_win_sync(self%id, error0)
+    call handle_errorflag(error0, "MPI_WIN_SYNC in mpifx_win_sync", error)
+
+    call mpi_barrier(self%comm_id, error1)
+    call handle_errorflag(error1, "MPI_BARRIER in mpifx_win_sync", error)
+
+  end subroutine mpifx_win_sync
+
+  !> Deallocates memory associated with a shared memory segment.
+  !!
+  !! \param self  Handle of the shared memory window.
+  !! \param error  Optional error code on return.
+  !!
+  !! \see MPI documentation (\c MPI_WIN_FREE)
+  !!
+  subroutine mpifx_win_free(self, error)
+    class(mpifx_win), intent(inout) :: self
+    integer, intent(out), optional :: error
+
+    integer :: error0
+
+    call mpi_win_free(self%id, error0)
+    call handle_errorflag(error0, "MPI_WIN_FREE in mpifx_win_free", error)
+
+  end subroutine mpifx_win_free
+
+
+#:for TYPE in TYPES
+  #:set FTYPE = FORTRAN_TYPES[TYPE]
+  #:set SUFFIX = TYPE_ABBREVS[TYPE]
+
+  $:mpifx_win_allocate_shared_template(SUFFIX, FTYPE)
+
+#:endfor
+
+end module mpifx_win_module
diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt
index 0be19fc..0b6785c 100644
--- a/test/CMakeLists.txt
+++ b/test/CMakeLists.txt
@@ -10,7 +10,7 @@ set(targets
   test_reduce
   test_scatter
   test_scatterv
-  test_shared_memory)
+  test_win_shared_mem)
 
 foreach(target IN LISTS targets)
   add_executable(${target} ${target}.f90)
diff --git a/test/meson.build b/test/meson.build
index 04fc3bb..fd98ff5 100644
--- a/test/meson.build
+++ b/test/meson.build
@@ -12,7 +12,7 @@ tests = [
   'reduce',
   'scatter',
   'scatterv',
-  'shared_memory',
+  'win_shared_mem',
 ]
 
 foreach t : tests
diff --git a/test/test_shared_memory.f90 b/test/test_win_shared_mem.f90
similarity index 68%
rename from test/test_shared_memory.f90
rename to test/test_win_shared_mem.f90
index ebce3cc..048fda8 100644
--- a/test/test_shared_memory.f90
+++ b/test/test_win_shared_mem.f90
@@ -1,10 +1,10 @@
-program test_shared_memory
+program test_win_shared_mem
   use libmpifx_module
   implicit none
 
   type(mpifx_comm) :: globalcomm, nodecomm
+  type(mpifx_win) :: win
   integer, parameter :: length = 7
-  integer :: win
   integer, pointer :: data_pointer(:)
 
   call mpifx_init()
@@ -13,22 +13,22 @@ program test_shared_memory
   ! Create a new communicator for all ranks on a node first
   call globalcomm%split_type(MPI_COMM_TYPE_SHARED, globalcomm%rank, nodecomm)
 
-  call mpifx_allocate_shared(nodecomm, length, win, data_pointer)
+  call win%allocate_shared(nodecomm, length, data_pointer)
 
-  call mpifx_lock_shared(win)
+  call win%lock()
 
   ! Only rank 0 writes data into the array
   if (nodecomm%lead) then
     data_pointer(:) = 42
   end if
 
-  call mpifx_sync_shared(nodecomm, win)
-  call mpifx_unlock_shared(win)
+  call win%sync()
+  call win%unlock()
 
   ! All ranks on the node will read the same value
   write(*, "(2(A,1X,I0,1X))") "ID:", nodecomm%rank, "VALUE:", data_pointer(1)
 
-  call mpifx_free_shared(win)
+  call win%free()
   call mpifx_finalize()
 
-end program test_shared_memory
+end program test_win_shared_mem

From f9e03274f5a335cfc8e90209e3ccf4a8077924b0 Mon Sep 17 00:00:00 2001
From: Tobias Melson <tobias.melson@mpcdf.mpg.de>
Date: Wed, 23 Feb 2022 14:12:34 +0100
Subject: [PATCH 3/5] Use storage_size to determine the required bytes

kind() does not always return the number of bytes for the data type.
Instead, storage_size() does what we want here.
---
 lib/mpifx_win.fpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp
index 2d9ece3..1bd2d63 100644
--- a/lib/mpifx_win.fpp
+++ b/lib/mpifx_win.fpp
@@ -65,7 +65,7 @@ contains
     integer(MPI_ADDRESS_KIND) :: local_length
     type(c_ptr) :: baseptr
 
-    disp_unit = kind(shared_data)
+    disp_unit = storage_size(shared_data) / 8
 
     local_length = 0
     if (mycomm%lead) then

From 3dce2ea873a2568d8d63ce5c3029c28012dfbc50 Mon Sep 17 00:00:00 2001
From: Tobias Melson <tobias.melson@mpcdf.mpg.de>
Date: Fri, 25 Feb 2022 14:39:16 +0100
Subject: [PATCH 4/5] Avoid integer overflow when calculating length

It may happen that the product of the two 4-byte integers overflows
before assigning to the 8-byte integer. We need to explicitly convert to
8 bytes first before multiplying.
---
 lib/mpifx_win.fpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp
index 1bd2d63..f54efd2 100644
--- a/lib/mpifx_win.fpp
+++ b/lib/mpifx_win.fpp
@@ -69,7 +69,7 @@ contains
 
     local_length = 0
     if (mycomm%lead) then
-      local_length = length * disp_unit
+      local_length = int(length, kind=MPI_ADDRESS_KIND) * disp_unit
     end if
 
     call mpi_win_allocate_shared(local_length, disp_unit, MPI_INFO_NULL, mycomm%id, baseptr, self%id, error0)

From 6d96ce0b3b75c181c94d10b35770b74e587836fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?B=C3=A1lint=20Aradi?= <aradi@uni-bremen.de>
Date: Mon, 28 Feb 2022 11:55:09 +0100
Subject: [PATCH 5/5] Make comm id private, simplify fypp-template

---
 lib/mpifx_win.fpp | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/lib/mpifx_win.fpp b/lib/mpifx_win.fpp
index f54efd2..1d96892 100644
--- a/lib/mpifx_win.fpp
+++ b/lib/mpifx_win.fpp
@@ -12,15 +12,14 @@ module mpifx_win_module
 
   !> MPI shared memory window with some additional information.
   type mpifx_win
-    integer :: id       !< Window id.
+    private
+    integer, public :: id       !< Window id.
     integer :: comm_id  !< Communicator id.
   contains
     !> Initializes an MPI shared memory window.
-    generic :: allocate_shared => &
-#:for TYPE in TYPES[:-1]
-    & mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$,&
+#:for TYPE in TYPES
+    generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$
 #:endfor
-    & mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPES[-1]]}$
 
 #:for TYPE in TYPES
     procedure, private :: mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$