diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index fd60e775..2303f003 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -102,7 +102,7 @@ jobs: compiler_cc: nvc compiler_cxx: nvc++ compiler_fc: nvfortran - cmake_options: -DCMAKE_CXX_FLAGS=--diag_suppress177 + cmake_options: -DCMAKE_CXX_FLAGS=--diag_suppress177 -DMPI_ARGS=--oversubscribe caching: true coverage: false @@ -115,7 +115,7 @@ jobs: compiler_fc: gfortran-13 caching: true coverage: false - cmake_options: -DMPI_SLOTS=4 + cmake_options: -DMPI_SLOTS=4 -DMPI_ARGS=--oversubscribe runs-on: ${{ matrix.os }} steps: diff --git a/src/fiat/mpl/internal_deprecated/mpl_setdflt_comm_mod.F90 b/src/fiat/mpl/internal_deprecated/mpl_setdflt_comm_mod.F90 index df670fd2..8f1c651a 100644 --- a/src/fiat/mpl/internal_deprecated/mpl_setdflt_comm_mod.F90 +++ b/src/fiat/mpl/internal_deprecated/mpl_setdflt_comm_mod.F90 @@ -47,8 +47,7 @@ MODULE MPL_SETDFLT_COMM_MOD USE EC_PARKIND, ONLY : JPIM USE OML_MOD, ONLY : OML_MY_THREAD -USE MPL_DATA_MODULE, ONLY : MPL_COMM_OML, MPL_NUMPROC - +USE MPL_DATA_MODULE, ONLY : MPL_COMM_OML, MPL_RANK, MPL_NUMPROC IMPLICIT NONE PRIVATE @@ -71,12 +70,16 @@ SUBROUTINE MPL_SETDFLT_COMM(KCOMM,KCOMM_OLD) INTEGER(KIND=JPIM) :: IER INTEGER(KIND=JPIM) :: ITID +INTEGER(KIND=JPIM) :: IRANK ITID = OML_MY_THREAD() KCOMM_OLD=MPL_COMM_OML(ITID) MPL_COMM_OML(ITID)=KCOMM -CALL MPI_COMM_SIZE(KCOMM,MPL_NUMPROC,IER) +! Get rank in and size of new communicator +CALL MPI_COMM_RANK(KCOMM, IRANK, IER) +MPL_RANK = IRANK + 1 +CALL MPI_COMM_SIZE(KCOMM, MPL_NUMPROC, IER) RETURN END SUBROUTINE MPL_SETDFLT_COMM diff --git a/src/fiat/mpl/internal_f08/mpl_setdflt_comm_mod.F90 b/src/fiat/mpl/internal_f08/mpl_setdflt_comm_mod.F90 index 85ea4aa1..bb8d293c 100644 --- a/src/fiat/mpl/internal_f08/mpl_setdflt_comm_mod.F90 +++ b/src/fiat/mpl/internal_f08/mpl_setdflt_comm_mod.F90 @@ -48,7 +48,7 @@ MODULE MPL_SETDFLT_COMM_MOD USE OML_MOD, ONLY : OML_MY_THREAD USE MPL_MPI, ONLY : MPI_COMM, MPI_COMM_SIZE -USE MPL_DATA_MODULE, ONLY : MPL_COMM_OML, MPL_NUMPROC +USE MPL_DATA_MODULE, ONLY : MPL_COMM_OML, MPL_RANK, MPL_NUMPROC IMPLICIT NONE @@ -71,6 +71,7 @@ SUBROUTINE MPL_SETDFLT_COMM(KCOMM,KCOMM_OLD) TYPE(MPI_COMM) :: KCOMM_LOCAL INTEGER(KIND=JPIM) :: IER INTEGER(KIND=JPIM) :: ITID +INTEGER(KIND=JPIM) :: IRANK ITID = OML_MY_THREAD() KCOMM_LOCAL%MPI_VAL=KCOMM @@ -78,7 +79,10 @@ SUBROUTINE MPL_SETDFLT_COMM(KCOMM,KCOMM_OLD) KCOMM_OLD=MPL_COMM_OML(ITID) MPL_COMM_OML(ITID)=KCOMM -CALL MPI_COMM_SIZE(KCOMM_LOCAL,MPL_NUMPROC,IER) +! Get rank in and size of new communicator +CALL MPI_COMM_RANK(KCOMM_LOCAL, IRANK, IER) +MPL_RANK = IRANK + 1 +CALL MPI_COMM_SIZE(KCOMM_LOCAL, MPL_NUMPROC, IER) RETURN END SUBROUTINE MPL_SETDFLT_COMM diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index f312a0c2..3092c063 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -207,6 +207,23 @@ add_test(NAME fiat_test_mpl_no_output "-DLAUNCH=${LAUNCH}" -P ${CMAKE_CURRENT_SOURCE_DIR}/test_mpl_no_output.cmake ) +# ---------------------------------------------------------------------------------------- +# Tests: fiat_test_mpl_split_comm +# test that MPL split communicator functionality works + +ecbuild_add_executable( + TARGET fiat-test-mpl-split-comm + SOURCES test_mpl_split_comm.F90 + LIBS fiat + LINKER_LANGUAGE Fortran + NOINSTALL ) + +ecbuild_add_test( + TARGET fiat_test_mpl_split_comm + COMMAND fiat-test-mpl-split-comm + CONDITION HAVE_MPI + MPI 4 ) + # ---------------------------------------------------------------------------------------- # Tests: fiat_test_abor1 # diff --git a/tests/test_mpl_split_comm.F90 b/tests/test_mpl_split_comm.F90 new file mode 100644 index 00000000..202af251 --- /dev/null +++ b/tests/test_mpl_split_comm.F90 @@ -0,0 +1,63 @@ +! (C) Copyright 2025- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. + +PROGRAM TEST_MPL_SPLIT_COMM + +USE EC_PARKIND, ONLY: JPIM +USE MPL_MODULE, ONLY: MPL_INIT, MPL_NPROC, MPL_MYRANK, MPL_COMM, MPL_COMM_SPLIT, MPL_SETDFLT_COMM, & + & MPL_ABORT, MPL_END + +IMPLICIT NONE + +INTEGER(JPIM), PARAMETER :: STDOUT = 6 + +INTEGER(JPIM) :: IGLOBAL_NPROC, IGLOBAL_RANK, ISPLIT_COLOUR, IERROR, ISPLIT_COMM, IDUMMY_COMM +INTEGER(JPIM) :: ISPLIT_RANK, ISPLIT_NPROC + +CALL MPL_INIT + +IGLOBAL_NPROC = MPL_NPROC() +IGLOBAL_RANK = MPL_MYRANK() + +! First rank in group 0, others in group 1 +ISPLIT_COLOUR = MERGE(0, 1, IGLOBAL_RANK == 1) + +! Split world communicator according to rank colour +CALL MPL_COMM_SPLIT(MPL_COMM, ISPLIT_COLOUR, IGLOBAL_RANK, ISPLIT_COMM, IERROR) + +IF (IERROR /= 0) THEN + CALL MPL_ABORT("TEST_MPL_SPLIT_COMM: MPL_COMM_SPLIT failed") +ENDIF + +! Set new split communicator as default +CALL MPL_SETDFLT_COMM(ISPLIT_COMM, IDUMMY_COMM) + +! Get rank and comm size in new split communicator +ISPLIT_RANK = MPL_MYRANK() +ISPLIT_NPROC = MPL_NPROC() + +! Check all values are correct +IF (IGLOBAL_RANK == 1) THEN + IF (ISPLIT_NPROC /= 1) THEN + CALL MPL_ABORT("TEST_MPL_SPLIT_COMM: 1st split comm does not have 1 rank") + ENDIF + IF (ISPLIT_RANK /= 1) THEN + CALL MPL_ABORT("TEST_MPL_SPLIT_COMM: 1st global rank is not 1st rank in 1st split comm") + ENDIF +ELSE + IF (ISPLIT_NPROC /= IGLOBAL_NPROC - 1) THEN + CALL MPL_ABORT("TEST_MPL_SPLIT_COMM: 2nd split comm does not have correct # ranks") + ENDIF + IF (ISPLIT_RANK /= IGLOBAL_RANK - 1) THEN + CALL MPL_ABORT("TEST_MPL_SPLIT_COMM: rank does not have correct number in 2nd split comm") + ENDIF +ENDIF + +CALL MPL_END(LDMEMINFO=.FALSE.) + +END PROGRAM TEST_MPL_SPLIT_COMM