From aa15bed6c0aff8edc2698efbcbb830967a3d6927 Mon Sep 17 00:00:00 2001 From: Tobias Melson Date: Mon, 21 Feb 2022 10:33:12 +0100 Subject: [PATCH] Implemented mpifx_comm_split_type Calling mpi_comm_split_type is especially necessary if you want to split the global communicator into groups that share a common memory. On a cluster, that would mean you get a new communicator for each node. --- lib/mpifx_comm.fpp | 51 +++++++++++++++++++++++++++++++++++ lib/mpifx_constants.fpp | 1 + test/CMakeLists.txt | 1 + test/meson.build | 1 + test/test_comm_split_type.f90 | 13 +++++++++ 5 files changed, 67 insertions(+) create mode 100644 test/test_comm_split_type.f90 diff --git a/lib/mpifx_comm.fpp b/lib/mpifx_comm.fpp index 79fbcf2..1d7b01a 100644 --- a/lib/mpifx_comm.fpp +++ b/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. diff --git a/lib/mpifx_constants.fpp b/lib/mpifx_constants.fpp index c133034..2a0a22f 100644 --- a/lib/mpifx_constants.fpp +++ b/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 diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 33983d7..29760dd 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -4,6 +4,7 @@ set(targets test_allreduce test_bcast test_comm_split + test_comm_split_type test_gather test_gatherv test_reduce diff --git a/test/meson.build b/test/meson.build index eb813e3..cbfc239 100644 --- a/test/meson.build +++ b/test/meson.build @@ -6,6 +6,7 @@ tests = [ 'allreduce', 'bcast', 'comm_split', + 'comm_split_type', 'gather', 'gatherv', 'reduce', diff --git a/test/test_comm_split_type.f90 b/test/test_comm_split_type.f90 new file mode 100644 index 0000000..c40491c --- /dev/null +++ b/test/test_comm_split_type.f90 @@ -0,0 +1,13 @@ +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