Make sure MPL_RANK is updated with new comm

.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:

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

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,14 +71,18 @@ 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
 
 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

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
 #

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