Merge pull request #39 from aradi/stage-1.3

Release 1.3

CHANGELOG.rst

@@ -5,6 +5,19 @@ Change Log
 Notable project changes in various releases.
 
 
+1.3
+===
+
+Added
+------
+
+* Grid splitting based on type (e.g. MPI_COMM_TYPE_SHARED)
+
+* Wrappers for accessing MPI shared memory window
+
+* Some tests accessible via ctest
+
+
 1.2
 ===
 

CMakeLists.txt

@@ -34,6 +34,7 @@ include(GNUInstallDirs)
 
 add_subdirectory(lib)
 if(NOT BUILD_EXPORTED_TARGETS_ONLY)
+  enable_testing()
   add_subdirectory(test)
 endif()
 

VERSION

@@ -1 +1 @@
-1.2.0
+1.3.0

doc/doxygen/Doxyfile

@@ -32,7 +32,7 @@ PROJECT_NAME           = "MpiFx"
 # This could be handy for archiving the generated documentation or
 # if some version control system is used.
 
-PROJECT_NUMBER = "1.2.0"
+PROJECT_NUMBER = "1.3.0"
 
 # Using the PROJECT_BRIEF tag one can provide an optional one line description
 # for a project that appears at the top of each page and should give viewer

doc/sphinx/conf.py

@@ -45,10 +45,10 @@
 # built documents.
 #
 # The short X.Y version.
-version = '1.2'
+version = '1.3'
 
 # The full version, including alpha/beta/rc tags.
-release = '1.2.0'
+release = '1.3.0'
 
 # The language for content autogenerated by Sphinx. Refer to documentation
 # for a list of supported languages.

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_win.fpp)
 
 fypp_preprocess("${sources-fpp}" sources-f90)
 

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

lib/module.fpp

@@ -30,6 +30,7 @@ module libmpifx_module
   use mpifx_allgatherv_module
   use mpifx_scatter_module
   use mpifx_scatterv_module
+  use mpifx_win_module
   implicit none
   public
 

lib/mpifx_comm.fpp

@@ -21,6 +21,9 @@ module mpifx_comm_module
     !> Creates a new communicator by splitting the old one.
     procedure :: split => mpifx_comm_split
 
+    !> Creates a new communicator by splitting the old one given a split type.
+    procedure :: split_type => mpifx_comm_split_type
+
     !> Frees the communicator. The communicator should not be used after this.
     procedure :: free => mpifx_comm_free
 
@@ -111,6 +114,54 @@ contains
   end subroutine mpifx_comm_split
 
 
+  !> Creates a new communicator by splitting the old one applying a given split type.
+  !!
+  !! \param self  Communicator instance.
+  !! \param splittype  Determines which ranks to be grouped together. In MPI 3.0,
+  !!     this can only be MPI_COMM_TYPE_SHARED grouping all MPI ranks together
+  !!     that can share memory (usually on a node).
+  !! \param rankkey  Is used to determine the rank of the process in its new
+  !!     communicator. Processes calling the routine with a higher value will
+  !!     have a higher rank in the new communicator.
+  !! \param newcomm  New communicator for the given process.
+  !! \param error  Optional error code on return.
+  !!
+  !! Example:
+  !!
+  !!     program test_split_type
+  !!       use libmpifx_module
+  !!       implicit none
+  !!
+  !!       type(mpifx_comm) :: allproc, splitproc
+  !!
+  !!       call mpifx_init()
+  !!       call allproc%init()
+  !!       call allproc%split_type(MPI_COMM_TYPE_SHARED, allproc%rank, splitproc)
+  !!       write(*, "(2(A,1X,I0,1X))") "ID:", allproc%rank, "SPLIT ID", splitproc%rank
+  !!       call mpifx_finalize()
+  !!
+  !!     end program test_split_type
+  !!
+  !! \see MPI documentation (\c MPI_COMM_SPLIT_TYPE)
+  !!
+  subroutine mpifx_comm_split_type(self, splittype, rankkey, newcomm, error)
+    class(mpifx_comm), intent(inout) :: self
+    integer, intent(in) :: splittype, rankkey
+    class(mpifx_comm), intent(out) :: newcomm
+    integer, intent(out), optional :: error
+
+    integer :: error0, newcommid
+
+    call mpi_comm_split_type(self%id, splittype, rankkey, MPI_INFO_NULL, newcommid, error0)
+    call handle_errorflag(error0, "mpi_comm_split_type() in mpifx_comm_split_type()", error)
+    if (error0 /= 0) then
+      return
+    end if
+    call newcomm%init(newcommid, error)
+
+  end subroutine mpifx_comm_split_type
+
+
   !> Frees the MPI communicator.
   !>
   !> After this call, the passed communicator should not be used any more.

lib/mpifx_constants.fpp

@@ -8,6 +8,7 @@ module mpifx_constants_module
   public :: MPI_LAND, MPI_BAND, MPI_LOR, MPI_BOR, MPI_LXOR ,MPI_BXOR
   public :: MPI_MAXLOC, MPI_MINLOC
   public :: MPI_THREAD_SINGLE, MPI_THREAD_FUNNELED, MPI_THREAD_SERIALIZED, MPI_THREAD_MULTIPLE
+  public :: MPI_COMM_TYPE_SHARED
   public :: MPIFX_UNHANDLED_ERROR, MPIFX_ASSERT_FAILED
 
 

lib/mpifx_win.fpp

@@ -0,0 +1,171 @@
+#: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
+    private
+    integer, public :: id       !< Window id.
+    integer :: comm_id  !< Communicator id.
+  contains
+    !> Initializes an MPI shared memory window.
+#:for TYPE in TYPES
+    generic :: allocate_shared => mpifx_win_allocate_shared_${TYPE_ABBREVS[TYPE]}$
+#:endfor
+
+#: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 = storage_size(shared_data) / 8
+
+    local_length = 0
+    if (mycomm%lead) then
+      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)
+    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

test/CMakeLists.txt

@@ -1,16 +1,43 @@
-set(targets
+set(tested
   test_allgather
-  test_allgatherv
+  test_allgatherv)
+
+set(targets
+  ${tested}
   test_allreduce
   test_bcast
   test_comm_split
+  test_comm_split_type
   test_gather
   test_gatherv
   test_reduce
   test_scatter
-  test_scatterv)
+  test_scatterv
+  test_win_shared_mem)
+
+set(sources-helper
+  testhelper.f90)
+
+add_library(mpifxtesthelp ${sources-helper})
+target_link_libraries(mpifxtesthelp PRIVATE MPI::MPI_Fortran MpiFx)
 
 foreach(target IN LISTS targets)
   add_executable(${target} ${target}.f90)
-  target_link_libraries(${target} MpiFx)
+  target_link_libraries(${target} MpiFx mpifxtesthelp)
+endforeach()
+
+foreach(target IN LISTS tested)
+  add_test(NAME ${target}
+    COMMAND ${MPIEXEC_EXECUTABLE}
+    ${MPIEXEC_NUMPROC_FLAG}
+    ${MPIEXEC_MAX_NUMPROCS}
+    ${MPIEXEC_PREFLAGS}
+    ${CMAKE_CURRENT_BINARY_DIR}/${target}
+    ${MPIEXEC_POSTFLAGS})
+  set_tests_properties(${target} PROPERTIES
+    # test cases generate this on stdOut
+    PASS_REGULAR_EXPRESSION "TestPASSED")
+  set_tests_properties(${target} PROPERTIES
+    # test cases generate this on stdOut
+    FAIL_REGULAR_EXPRESSION "TestFAILED")
 endforeach()

test/meson.build

@@ -6,11 +6,13 @@ tests = [
   'allreduce',
   'bcast',
   'comm_split',
+  'comm_split_type',
   'gather',
   'gatherv',
   'reduce',
   'scatter',
   'scatterv',
+  'win_shared_mem',
 ]
 
 foreach t : tests