From 6b171e8af18b30c2b3dfb8ef7b87333c6ca8edd1 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 25 Jun 2025 17:37:28 -0600 Subject: [PATCH 1/7] Some updates to CMakeLists that get closer, but aren't quite working yet. FATES code is still having problems like not getting the shr_log_mod and errMsg subroutine in it, and this is setup for the shr_mpi_mod stub, but the testing will need to use the full shr_mpi_mod code. It also looks like getting the CESM unit testing to work with MPI would be an effort as we don't even build pFUnit with MPI libraries (although we did on Cheyenne) --- src/CMakeLists.txt | 11 ++- src/main/CMakeLists.txt | 2 + src/main/test/CMakeLists.txt | 1 + src/main/test/decomp_test/CMakeLists.txt | 8 ++ src/main/test/decomp_test/test_decompInit.pf | 88 ++++++++++++++++++++ src/utils/CMakeLists.txt | 1 + 6 files changed, 110 insertions(+), 1 deletion(-) create mode 100644 src/main/test/decomp_test/CMakeLists.txt create mode 100644 src/main/test/decomp_test/test_decompInit.pf diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9707af4f0b..3cc02f03ea 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -57,6 +57,14 @@ add_subdirectory(${CLM_ROOT}/src/main clm_main) add_subdirectory(${CLM_ROOT}/src/init_interp clm_init_interp) add_subdirectory(${CLM_ROOT}/src/self_tests clm_self_tests) +# Add FATES source directories +add_subdirectory(${CLM_ROOT}/src/fates/main fates_main) +add_subdirectory(${CLM_ROOT}/src/fates/biogeochem fates_biogeochem) +add_subdirectory(${CLM_ROOT}/src/fates/biogeophys fates_biogeophys) +add_subdirectory(${CLM_ROOT}/src/fates/parteh fates_parteh) +add_subdirectory(${CLM_ROOT}/src/fates/fire fates_fire) +add_subdirectory(${CLM_ROOT}/src/fates/radiation fates_radiation) + # Add general unit test directories (stubbed out files, etc.) add_subdirectory(unit_test_stubs) add_subdirectory(unit_test_shr) @@ -90,8 +98,9 @@ endforeach() add_library(csm_share ${share_sources} ${drv_sources_needed}) declare_generated_dependencies(csm_share "${share_genf90_sources}") add_library(clm ${clm_sources}) +add_library(fates ${fates_sources}) declare_generated_dependencies(clm "${clm_genf90_sources}") -add_dependencies(clm csm_share esmf) +add_dependencies(clm csm_share esmf fates) # We need to look for header files here, in order to pick up shr_assert.h include_directories(${CLM_ROOT}/share/include) diff --git a/src/main/CMakeLists.txt b/src/main/CMakeLists.txt index 53a6edb8a5..d249a1da8d 100644 --- a/src/main/CMakeLists.txt +++ b/src/main/CMakeLists.txt @@ -19,6 +19,7 @@ list(APPEND clm_sources clm_varsur.F90 column_varcon.F90 decompMod.F90 + decompInitMod.F90 filterColMod.F90 glc2lndMod.F90 glcBehaviorMod.F90 @@ -29,6 +30,7 @@ list(APPEND clm_sources ncdio_utils.F90 organicFileMod.F90 paramUtilMod.F90 + subgridMod.F90 subgridAveMod.F90 subgridWeightsMod.F90 surfrdUtilsMod.F90 diff --git a/src/main/test/CMakeLists.txt b/src/main/test/CMakeLists.txt index 97bbf081cc..588bc5a50e 100644 --- a/src/main/test/CMakeLists.txt +++ b/src/main/test/CMakeLists.txt @@ -8,3 +8,4 @@ add_subdirectory(filter_test) add_subdirectory(initVertical_test) add_subdirectory(ncdio_utils_test) add_subdirectory(topo_test) +add_subdirectory(decomp_test) diff --git a/src/main/test/decomp_test/CMakeLists.txt b/src/main/test/decomp_test/CMakeLists.txt new file mode 100644 index 0000000000..3499774292 --- /dev/null +++ b/src/main/test/decomp_test/CMakeLists.txt @@ -0,0 +1,8 @@ +set(pfunit_sources + test_decompInit.pf) + +add_pfunit_ctest(decomp + TEST_SOURCES "${pfunit_sources}" + LINK_LIBRARIES clm csm_share esmf + EXTRA_FINALIZE unittest_finalize_esmf + EXTRA_USE unittestInitializeAndFinalize) diff --git a/src/main/test/decomp_test/test_decompInit.pf b/src/main/test/decomp_test/test_decompInit.pf new file mode 100644 index 0000000000..c7f71e8ea2 --- /dev/null +++ b/src/main/test/decomp_test/test_decompInit.pf @@ -0,0 +1,88 @@ +module test_decompInit + + ! Tests of decompInitMod + + use funit + use decompMod, only : bounds + use decompInitMod + use unittestSubgridMod + use unittestSimpleSubgridSetupsMod, only : setup_single_veg_patch, setup_n_veg_patches + use glcBehaviorMod, only: glc_behavior_type + use shr_kind_mod , only : r8 => shr_kind_r8 + + implicit none + + @TestCase + type, extends(TestCase) :: TestDecomp + contains + procedure :: setUp + procedure :: tearDown + procedure :: create_glc_behavior + end type TestDecomp + +contains + + ! ======================================================================== + ! Helper routines + ! ======================================================================== + + subroutine setUp(this) + class(TestDecomp), intent(inout) :: this + end subroutine setUp + + subroutine tearDown(this) + class(TestDecomp), intent(inout) :: this + + end subroutine tearDown + + !----------------------------------------------------------------------- + function create_glc_behavior() result(glc_behavior) + ! + ! !DESCRIPTION: + ! Creates a glc_behavior instance with collapse_to_atm_topo set for all + ! + ! Must be called *after* setting up the subgrid structure. + ! + use unittestArrayMod, only : grc_array + ! !ARGUMENTS: + type(glc_behavior_type) :: glc_behavior ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'create_glc_behavior' + !----------------------------------------------------------------------- + + call glc_behavior%InitSetDirectly(bounds%begg, bounds%endg, & + has_virtual_columns = grc_array(.false.), & + collapse_to_atm_topo = grc_array(collapse_to_atm_topo=.true.)) + + end function create_glc_behavior + + ! ======================================================================== + ! Begin tests + ! ======================================================================== + + @Test + subroutine decompInitClumps_basic(this) + use glcBehaviorMod, only : glc_behavior_type + ! Test basic operation of decompInit_clumps + class(TestDecomp), intent(inout) :: this + + ! Local + type(glc_behavior_type) :: glc_behavior + integer :: ni, nj + + ! Setup a single grid cell + nj = 1 + ni = 1 + call setup_single_veg_patch(pft_type=1) + glc_behavior = create_glc_behavior() + + ! Exercise + ! Determine decomposition of subgrid scale landunits, columns, patches + call decompInit_clumps(ni, nj, glc_behavior) + + ! Verify + end subroutine decompInitClumps_basic + +end module test_decompInit diff --git a/src/utils/CMakeLists.txt b/src/utils/CMakeLists.txt index 04ad683517..9038b6dbca 100644 --- a/src/utils/CMakeLists.txt +++ b/src/utils/CMakeLists.txt @@ -22,6 +22,7 @@ list(APPEND clm_sources SparseMatrixMultiplyMod.F90 IssueFixedMetadataHandler.F90 NumericsMod.F90 + spmdMod.F90 ) sourcelist_to_parent(clm_sources) From e56de4c83d9e54c3f557024a27da3e70a429b022 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 17 Jan 2026 14:16:44 -0700 Subject: [PATCH 2/7] Get a simple test of DecompMod for get_proc_bounds and get_clump_bounds working, had to remove decompInitMod and subgridMod --- src/main/CMakeLists.txt | 2 - src/main/test/decomp_test/CMakeLists.txt | 2 +- src/main/test/decomp_test/test_decompInit.pf | 88 --------------- src/main/test/decomp_test/test_decompMod.pf | 106 +++++++++++++++++++ 4 files changed, 107 insertions(+), 91 deletions(-) delete mode 100644 src/main/test/decomp_test/test_decompInit.pf create mode 100644 src/main/test/decomp_test/test_decompMod.pf diff --git a/src/main/CMakeLists.txt b/src/main/CMakeLists.txt index 3884e0ba36..fc324efeb9 100644 --- a/src/main/CMakeLists.txt +++ b/src/main/CMakeLists.txt @@ -19,7 +19,6 @@ list(APPEND clm_sources clm_varsur.F90 column_varcon.F90 decompMod.F90 - decompInitMod.F90 filterColMod.F90 FireMethodType.F90 glc2lndMod.F90 @@ -31,7 +30,6 @@ list(APPEND clm_sources ncdio_utils.F90 organicFileMod.F90 paramUtilMod.F90 - subgridMod.F90 subgridAveMod.F90 subgridWeightsMod.F90 surfrdUtilsMod.F90 diff --git a/src/main/test/decomp_test/CMakeLists.txt b/src/main/test/decomp_test/CMakeLists.txt index 3499774292..b8c6fea3cf 100644 --- a/src/main/test/decomp_test/CMakeLists.txt +++ b/src/main/test/decomp_test/CMakeLists.txt @@ -1,5 +1,5 @@ set(pfunit_sources - test_decompInit.pf) + test_decompMod.pf) add_pfunit_ctest(decomp TEST_SOURCES "${pfunit_sources}" diff --git a/src/main/test/decomp_test/test_decompInit.pf b/src/main/test/decomp_test/test_decompInit.pf deleted file mode 100644 index c7f71e8ea2..0000000000 --- a/src/main/test/decomp_test/test_decompInit.pf +++ /dev/null @@ -1,88 +0,0 @@ -module test_decompInit - - ! Tests of decompInitMod - - use funit - use decompMod, only : bounds - use decompInitMod - use unittestSubgridMod - use unittestSimpleSubgridSetupsMod, only : setup_single_veg_patch, setup_n_veg_patches - use glcBehaviorMod, only: glc_behavior_type - use shr_kind_mod , only : r8 => shr_kind_r8 - - implicit none - - @TestCase - type, extends(TestCase) :: TestDecomp - contains - procedure :: setUp - procedure :: tearDown - procedure :: create_glc_behavior - end type TestDecomp - -contains - - ! ======================================================================== - ! Helper routines - ! ======================================================================== - - subroutine setUp(this) - class(TestDecomp), intent(inout) :: this - end subroutine setUp - - subroutine tearDown(this) - class(TestDecomp), intent(inout) :: this - - end subroutine tearDown - - !----------------------------------------------------------------------- - function create_glc_behavior() result(glc_behavior) - ! - ! !DESCRIPTION: - ! Creates a glc_behavior instance with collapse_to_atm_topo set for all - ! - ! Must be called *after* setting up the subgrid structure. - ! - use unittestArrayMod, only : grc_array - ! !ARGUMENTS: - type(glc_behavior_type) :: glc_behavior ! function result - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'create_glc_behavior' - !----------------------------------------------------------------------- - - call glc_behavior%InitSetDirectly(bounds%begg, bounds%endg, & - has_virtual_columns = grc_array(.false.), & - collapse_to_atm_topo = grc_array(collapse_to_atm_topo=.true.)) - - end function create_glc_behavior - - ! ======================================================================== - ! Begin tests - ! ======================================================================== - - @Test - subroutine decompInitClumps_basic(this) - use glcBehaviorMod, only : glc_behavior_type - ! Test basic operation of decompInit_clumps - class(TestDecomp), intent(inout) :: this - - ! Local - type(glc_behavior_type) :: glc_behavior - integer :: ni, nj - - ! Setup a single grid cell - nj = 1 - ni = 1 - call setup_single_veg_patch(pft_type=1) - glc_behavior = create_glc_behavior() - - ! Exercise - ! Determine decomposition of subgrid scale landunits, columns, patches - call decompInit_clumps(ni, nj, glc_behavior) - - ! Verify - end subroutine decompInitClumps_basic - -end module test_decompInit diff --git a/src/main/test/decomp_test/test_decompMod.pf b/src/main/test/decomp_test/test_decompMod.pf new file mode 100644 index 0000000000..6bef1690d5 --- /dev/null +++ b/src/main/test/decomp_test/test_decompMod.pf @@ -0,0 +1,106 @@ +module test_decompMod + + ! Tests of decompMod + + use funit + use decompMod + use shr_kind_mod , only : r8 => shr_kind_r8 + + implicit none + + @TestCase + type, extends(TestCase) :: TestDecompMod + contains + procedure :: setUp + procedure :: tearDown + procedure :: create_simpleSingleDecomp + end type TestDecompMod + + integer, parameter :: ni = 2 + integer, parameter :: nj = 2 + +contains + + ! ======================================================================== + ! Helper routines + ! ======================================================================== + + subroutine setUp(this) + class(TestDecompMod), intent(inout) :: this + + call this%create_simpleSingleDecomp() + end subroutine setUp + + subroutine tearDown(this) + class(TestDecompMod), intent(inout) :: this + + call decompmod_clean() + + end subroutine tearDown + + subroutine create_simpleSingleDecomp(this) + use spmdMod, only : iam + class(TestDecompMod), intent(inout) :: this + + integer :: clump_pproc + ! TOTO: When decompMod has it's own allocate method that could be used here + nclumps = 1 + clump_pproc = nclumps + allocate(procinfo%cid(clump_pproc)) + allocate(clumps(nclumps)) + ! Set the procinfo and clumps values + ! TOD: Use initialization method when available (currently in decompInitMod) + procinfo%cid = 1 + procinfo%ncells = ni*nj + procinfo%begg = 1 + procinfo%endg = procinfo%ncells + procinfo%nclumps = nclumps + clumps(:)%owner = iam + clumps(:)%begg = 1 + clumps(:)%endg = procinfo%ncells + + end subroutine create_simpleSingleDecomp + ! ======================================================================== + ! Begin tests + ! ======================================================================== + + @Test + subroutine test_get_clump_bounds(this) + class(TestDecompMod), intent(inout) :: this + + type(bounds_type) :: bounds + integer :: n + + do n = 1, procinfo%nclumps + call get_clump_bounds(n, bounds) + @assertEqual(bounds%level, bounds_level_clump) + @assertEqual(bounds%clump_index, n) + end do + end subroutine test_get_clump_bounds + + @Test + subroutine test_get_proc_bounds(this) + class(TestDecompMod), intent(inout) :: this + + type(bounds_type) :: bounds + + ! Add optional argument, just to test that it can handle it + call get_proc_bounds(bounds, allow_call_from_threaded_region=.true.) + @assertEqual(bounds%level, bounds_level_proc) + @assertEqual(bounds%clump_index, -1) + end subroutine test_get_proc_bounds + + @Test + subroutine test_proc_clump_bounds_equal(this) + class(TestDecompMod), intent(inout) :: this + + type(bounds_type) :: bounds_clump, bounds_proc + + @assertTrue(procinfo%nclumps == 1) + call get_clump_bounds(1, bounds_clump) + call get_proc_bounds(bounds_proc) + @assertEqual(bounds_proc%begg, bounds_clump%begg) + @assertEqual(bounds_proc%endg, bounds_clump%endg) + end subroutine test_proc_clump_bounds_equal + +end module test_decompMod From 0461ea58a312d690e7e141ee0117de1c9f8ae00c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 18 Jan 2026 00:13:11 -0700 Subject: [PATCH 3/7] These changes build in using mpi-serial, on Derecho it requires setting the env variable MPISERIAL to \/glade/u/apps/derecho/23.09/spack/opt/spack/mpi-serial/2.5.0/oneapi/2023.2.1/p3fw and it appears that you have to run the build twice for it to work, as such I'll revert this afterwards. But, I'm saving the commit so it could be done easily in the future --- src/CMakeLists.txt | 22 +- src/unit_test_stubs/CMakeLists.txt | 1 - src/unit_test_stubs/csm_share/CMakeLists.txt | 5 - .../csm_share/shr_mpi_mod_stub.F90 | 487 ------------------ 4 files changed, 14 insertions(+), 501 deletions(-) delete mode 100644 src/unit_test_stubs/csm_share/CMakeLists.txt delete mode 100644 src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 52c8422055..70e9b364bb 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,6 +17,20 @@ include(CIME_utils) # NetCDF is required -- because PIO and NetCDF are required by the standard default ESMF libraries find_package(NetCDF 4.7.4 REQUIRED Fortran) +# The following - for finding MPISERIAL - is copied from the share CMakeLists.txt +if(DEFINED MPILIB) + if(${MPILIB} STREQUAL "mpi-serial") + find_package(MPISERIAL COMPONENTS C Fortran REQUIRED) + + # We need this for the sake of includes of mpif.h + include_directories(${MPISERIAL_Fortran_INCLUDE_DIR}) + else() + find_package(MPI REQUIRED) + endif() +else() + find_package(MPI REQUIRED) +endif() + # The following - for finding ESMF - is copied from the share CMakeLists.txt if(DEFINED ENV{ESMF_ROOT}) list(APPEND CMAKE_MODULE_PATH $ENV{ESMF_ROOT}/cmake) @@ -80,14 +94,6 @@ add_subdirectory(unit_test_shr) # Then each removal could be replaced with a single call, like: # remove_source_file(${share_sources} "shr_mpi_mod.F90") foreach(sourcefile ${share_sources}) - # Remove shr_mpi_mod from share_sources. - # This is needed because we want to use the mock shr_mpi_mod in place of the real one - string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) - - if(match_found) - list(REMOVE_ITEM share_sources ${sourcefile}) - endif() - # Remove shr_pio_mod from share_sources. This is needed to avoid an explicit dependency # on PIO. This removal is needed on some systems but not on others: the unit test build # works without this removal on a Mac with a pre-built PIO library, but failed (with diff --git a/src/unit_test_stubs/CMakeLists.txt b/src/unit_test_stubs/CMakeLists.txt index 2d7fe23378..5b1232be6e 100644 --- a/src/unit_test_stubs/CMakeLists.txt +++ b/src/unit_test_stubs/CMakeLists.txt @@ -1,4 +1,3 @@ -add_subdirectory(csm_share) add_subdirectory(dyn_subgrid) add_subdirectory(main) add_subdirectory(share_esmf) diff --git a/src/unit_test_stubs/csm_share/CMakeLists.txt b/src/unit_test_stubs/csm_share/CMakeLists.txt deleted file mode 100644 index 33ddbfb342..0000000000 --- a/src/unit_test_stubs/csm_share/CMakeLists.txt +++ /dev/null @@ -1,5 +0,0 @@ -list(APPEND share_sources - shr_mpi_mod_stub.F90 - ) - -sourcelist_to_parent(share_sources) diff --git a/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 b/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 deleted file mode 100644 index 44d57a96b0..0000000000 --- a/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 +++ /dev/null @@ -1,487 +0,0 @@ -!=============================================================================== -! SVN $Id: shr_mpi_mod.F90 59033 2014-04-11 01:55:15Z santos@ucar.edu $ -! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723/shr/shr_mpi_mod.F90 $ -!=============================================================================== - -Module shr_mpi_mod - -!------------------------------------------------------------------------------- -! PURPOSE: general layer on MPI functions -!------------------------------------------------------------------------------- - - use shr_kind_mod - use shr_log_mod, only: s_loglev => shr_log_Level - use shr_log_mod, only: s_logunit => shr_log_Unit - - implicit none - private - -! PUBLIC: Public interfaces - - public :: shr_mpi_chkerr - public :: shr_mpi_bcast - public :: shr_mpi_sum - public :: shr_mpi_commsize - public :: shr_mpi_commrank - public :: shr_mpi_initialized - public :: shr_mpi_abort - public :: shr_mpi_barrier - public :: shr_mpi_init - public :: shr_mpi_finalize - - interface shr_mpi_bcast ; module procedure & - shr_mpi_bcastc0, & - shr_mpi_bcastc1, & - shr_mpi_bcastl0, & - shr_mpi_bcastl1, & - shr_mpi_bcasti0, & - shr_mpi_bcasti1, & - shr_mpi_bcasti2, & - shr_mpi_bcastr0, & - shr_mpi_bcastr1, & - shr_mpi_bcastr2, & - shr_mpi_bcastr3 - end interface - -!=============================================================================== -CONTAINS -!=============================================================================== - -SUBROUTINE shr_mpi_chkerr(rcode,string) - - IMPLICIT none - - !----- arguments --- - integer(SHR_KIND_IN), intent(in) :: rcode ! input MPI error code - character(*), intent(in) :: string ! message - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_chkerr) ' - -!------------------------------------------------------------------------------- -! PURPOSE: layer on MPI error checking -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_chkerr - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcasti0(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - integer(SHR_KIND_IN), intent(inout):: vec ! vector of 1 - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcasti0) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast an integer -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcasti0 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastl0(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - logical, intent(inout):: vec ! vector of 1 - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcastl0) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a logical -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastl0 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastc0(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - character(len=*), intent(inout) :: vec ! vector of 1 - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcastc0) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a character string -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastc0 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastc1(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - character(len=*), intent(inout) :: vec(:) ! 1D vector - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcastc1) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a character string -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastc1 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastr0(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - real(SHR_KIND_R8), intent(inout):: vec ! vector of 1 - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcastr0) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a real -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastr0 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcasti1(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - integer(SHR_KIND_IN), intent(inout):: vec(:) ! vector - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcasti1) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a vector of integers -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcasti1 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastl1(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - logical, intent(inout):: vec(:) ! vector of 1 - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcastl1) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a logical -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastl1 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastr1(vec,comm,string,pebcast) - - IMPLICIT none - - !----- arguments --- - real(SHR_KIND_R8), intent(inout):: vec(:) ! vector - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_bcastr1) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a vector of reals -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastr1 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastr2(arr,comm,string,pebcast) - - IMPLICIT none - - !----- arguments ----- - real(SHR_KIND_R8), intent(inout):: arr(:,:) ! array, 2d - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local ----- - - !----- formats ----- - character(*),parameter :: subName = '(shr_mpi_bcastr2) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a 2d array of reals -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastr2 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcasti2(arr,comm,string,pebcast) - - IMPLICIT none - - !----- arguments ----- - integer, intent(inout):: arr(:,:) ! array, 2d - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local ----- - character(*),parameter :: subName = '(shr_mpi_bcasti2) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a 2d array of integers -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcasti2 - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_bcastr3(arr,comm,string,pebcast) - - IMPLICIT none - - !----- arguments ----- - real(SHR_KIND_R8), intent(inout):: arr(:,:,:) ! array, 3d - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) - - !----- local ----- - character(*),parameter :: subName = '(shr_mpi_bcastr3) ' - -!------------------------------------------------------------------------------- -! PURPOSE: Broadcast a 3d array of reals -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_bcastr3 - -!=============================================================================== - -SUBROUTINE shr_mpi_sum(lvec,gvec,comm,string,all) - - IMPLICIT none - - !----- arguments --- - integer(SHR_KIND_IN), intent(in) :: lvec ! in/out local values - integer(SHR_KIND_IN), intent(out):: gvec ! in/out global values - integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator - character(*),optional,intent(in) :: string ! message - logical, optional,intent(in) :: all ! allreduce if true - !----- local ----- - character(*),parameter :: subName = '(shr_mpi_sumi0) ' - -!=============================================================================== -END SUBROUTINE shr_mpi_sum - -!=============================================================================== - -SUBROUTINE shr_mpi_commsize(comm,size,string) - - IMPLICIT none - - !----- arguments --- - integer,intent(in) :: comm - integer,intent(out) :: size - character(*),optional,intent(in) :: string ! message - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_commsize) ' - -!------------------------------------------------------------------------------- -! PURPOSE: MPI commsize -!------------------------------------------------------------------------------- - size = 1 - -END SUBROUTINE shr_mpi_commsize - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_commrank(comm,rank,string) - - IMPLICIT none - - !----- arguments --- - integer,intent(in) :: comm - integer,intent(out) :: rank - character(*),optional,intent(in) :: string ! message - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_commrank) ' - -!------------------------------------------------------------------------------- -! PURPOSE: MPI commrank -!------------------------------------------------------------------------------- - rank = 0 - -END SUBROUTINE shr_mpi_commrank - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_initialized(flag,string) - - IMPLICIT none - - !----- arguments --- - logical,intent(out) :: flag - character(*),optional,intent(in) :: string ! message - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_initialized) ' - -!------------------------------------------------------------------------------- -! PURPOSE: MPI initialized -!------------------------------------------------------------------------------- - flag = .true. - -END SUBROUTINE shr_mpi_initialized - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_abort(string,rcode) - - IMPLICIT none - - !----- arguments --- - character(*),optional,intent(in) :: string ! message - integer,optional,intent(in) :: rcode ! optional code - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_abort) ' - integer :: rc ! return code - -!------------------------------------------------------------------------------- -! PURPOSE: MPI abort -!------------------------------------------------------------------------------- - - if ( present(string) .and. present(rcode) ) then - write(s_logunit,*) trim(subName),":",trim(string),rcode - endif - if ( present(rcode) )then - rc = rcode - else - rc = 1001 - end if - stop - -END SUBROUTINE shr_mpi_abort - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_barrier(comm,string) - - IMPLICIT none - - !----- arguments --- - integer,intent(in) :: comm - character(*),optional,intent(in) :: string ! message - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_barrier) ' - -!------------------------------------------------------------------------------- -! PURPOSE: MPI barrier -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_barrier - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_init(string) - - IMPLICIT none - - !----- arguments --- - character(*),optional,intent(in) :: string ! message - - !----- local --- - character(*),parameter :: subName = '(shr_mpi_init) ' - -!------------------------------------------------------------------------------- -! PURPOSE: MPI init -!------------------------------------------------------------------------------- - -END SUBROUTINE shr_mpi_init - -!=============================================================================== -!=============================================================================== - -SUBROUTINE shr_mpi_finalize(string) - - IMPLICIT none - - !----- arguments --- - character(*),optional,intent(in) :: string ! message - - !----- local --- - -!------------------------------------------------------------------------------- -! PURPOSE: MPI finalize -!------------------------------------------------------------------------------- - if ( present(string) ) & - write(s_logunit,*) trim(string) - call shr_mpi_abort("MPI Finalize") - -END SUBROUTINE shr_mpi_finalize - -!=============================================================================== -!=============================================================================== - -END MODULE shr_mpi_mod From 5e4fc9a5c28f96decedae3f2e4020e6baac4d7c9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 18 Jan 2026 00:13:24 -0700 Subject: [PATCH 4/7] Revert "These changes build in using mpi-serial, on Derecho it requires setting the env variable MPISERIAL to \/glade/u/apps/derecho/23.09/spack/opt/spack/mpi-serial/2.5.0/oneapi/2023.2.1/p3fw and it appears that you have to run the build twice for it to work, as such I'll revert this afterwards. But, I'm saving the commit so it could be done easily in the future" This reverts commit 0461ea58a312d690e7e141ee0117de1c9f8ae00c. --- src/CMakeLists.txt | 22 +- src/unit_test_stubs/CMakeLists.txt | 1 + src/unit_test_stubs/csm_share/CMakeLists.txt | 5 + .../csm_share/shr_mpi_mod_stub.F90 | 487 ++++++++++++++++++ 4 files changed, 501 insertions(+), 14 deletions(-) create mode 100644 src/unit_test_stubs/csm_share/CMakeLists.txt create mode 100644 src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 70e9b364bb..52c8422055 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,20 +17,6 @@ include(CIME_utils) # NetCDF is required -- because PIO and NetCDF are required by the standard default ESMF libraries find_package(NetCDF 4.7.4 REQUIRED Fortran) -# The following - for finding MPISERIAL - is copied from the share CMakeLists.txt -if(DEFINED MPILIB) - if(${MPILIB} STREQUAL "mpi-serial") - find_package(MPISERIAL COMPONENTS C Fortran REQUIRED) - - # We need this for the sake of includes of mpif.h - include_directories(${MPISERIAL_Fortran_INCLUDE_DIR}) - else() - find_package(MPI REQUIRED) - endif() -else() - find_package(MPI REQUIRED) -endif() - # The following - for finding ESMF - is copied from the share CMakeLists.txt if(DEFINED ENV{ESMF_ROOT}) list(APPEND CMAKE_MODULE_PATH $ENV{ESMF_ROOT}/cmake) @@ -94,6 +80,14 @@ add_subdirectory(unit_test_shr) # Then each removal could be replaced with a single call, like: # remove_source_file(${share_sources} "shr_mpi_mod.F90") foreach(sourcefile ${share_sources}) + # Remove shr_mpi_mod from share_sources. + # This is needed because we want to use the mock shr_mpi_mod in place of the real one + string(REGEX MATCH "shr_mpi_mod.F90" match_found ${sourcefile}) + + if(match_found) + list(REMOVE_ITEM share_sources ${sourcefile}) + endif() + # Remove shr_pio_mod from share_sources. This is needed to avoid an explicit dependency # on PIO. This removal is needed on some systems but not on others: the unit test build # works without this removal on a Mac with a pre-built PIO library, but failed (with diff --git a/src/unit_test_stubs/CMakeLists.txt b/src/unit_test_stubs/CMakeLists.txt index 5b1232be6e..2d7fe23378 100644 --- a/src/unit_test_stubs/CMakeLists.txt +++ b/src/unit_test_stubs/CMakeLists.txt @@ -1,3 +1,4 @@ +add_subdirectory(csm_share) add_subdirectory(dyn_subgrid) add_subdirectory(main) add_subdirectory(share_esmf) diff --git a/src/unit_test_stubs/csm_share/CMakeLists.txt b/src/unit_test_stubs/csm_share/CMakeLists.txt new file mode 100644 index 0000000000..33ddbfb342 --- /dev/null +++ b/src/unit_test_stubs/csm_share/CMakeLists.txt @@ -0,0 +1,5 @@ +list(APPEND share_sources + shr_mpi_mod_stub.F90 + ) + +sourcelist_to_parent(share_sources) diff --git a/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 b/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 new file mode 100644 index 0000000000..44d57a96b0 --- /dev/null +++ b/src/unit_test_stubs/csm_share/shr_mpi_mod_stub.F90 @@ -0,0 +1,487 @@ +!=============================================================================== +! SVN $Id: shr_mpi_mod.F90 59033 2014-04-11 01:55:15Z santos@ucar.edu $ +! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk_tags/share3_140723/shr/shr_mpi_mod.F90 $ +!=============================================================================== + +Module shr_mpi_mod + +!------------------------------------------------------------------------------- +! PURPOSE: general layer on MPI functions +!------------------------------------------------------------------------------- + + use shr_kind_mod + use shr_log_mod, only: s_loglev => shr_log_Level + use shr_log_mod, only: s_logunit => shr_log_Unit + + implicit none + private + +! PUBLIC: Public interfaces + + public :: shr_mpi_chkerr + public :: shr_mpi_bcast + public :: shr_mpi_sum + public :: shr_mpi_commsize + public :: shr_mpi_commrank + public :: shr_mpi_initialized + public :: shr_mpi_abort + public :: shr_mpi_barrier + public :: shr_mpi_init + public :: shr_mpi_finalize + + interface shr_mpi_bcast ; module procedure & + shr_mpi_bcastc0, & + shr_mpi_bcastc1, & + shr_mpi_bcastl0, & + shr_mpi_bcastl1, & + shr_mpi_bcasti0, & + shr_mpi_bcasti1, & + shr_mpi_bcasti2, & + shr_mpi_bcastr0, & + shr_mpi_bcastr1, & + shr_mpi_bcastr2, & + shr_mpi_bcastr3 + end interface + +!=============================================================================== +CONTAINS +!=============================================================================== + +SUBROUTINE shr_mpi_chkerr(rcode,string) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: rcode ! input MPI error code + character(*), intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_chkerr) ' + +!------------------------------------------------------------------------------- +! PURPOSE: layer on MPI error checking +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_chkerr + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast an integer +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcasti0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastl0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a logical +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastl0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastc0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + character(len=*), intent(inout) :: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastc0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a character string +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastc0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastc1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + character(len=*), intent(inout) :: vec(:) ! 1D vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastc1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a character string +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastc1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr0(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(inout):: vec ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastr0) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a real +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr0 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcasti1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a vector of integers +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcasti1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastl1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + logical, intent(inout):: vec(:) ! vector of 1 + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastl1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a logical +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastl1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr1(vec,comm,string,pebcast) + + IMPLICIT none + + !----- arguments --- + real(SHR_KIND_R8), intent(inout):: vec(:) ! vector + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_bcastr1) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a vector of reals +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr1 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr2(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(inout):: arr(:,:) ! array, 2d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + + !----- formats ----- + character(*),parameter :: subName = '(shr_mpi_bcastr2) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a 2d array of reals +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr2 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcasti2(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + integer, intent(inout):: arr(:,:) ! array, 2d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + character(*),parameter :: subName = '(shr_mpi_bcasti2) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a 2d array of integers +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcasti2 + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_bcastr3(arr,comm,string,pebcast) + + IMPLICIT none + + !----- arguments ----- + real(SHR_KIND_R8), intent(inout):: arr(:,:,:) ! array, 3d + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + integer(SHR_KIND_IN), optional, intent(in) :: pebcast ! bcast pe (otherwise zero) + + !----- local ----- + character(*),parameter :: subName = '(shr_mpi_bcastr3) ' + +!------------------------------------------------------------------------------- +! PURPOSE: Broadcast a 3d array of reals +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_bcastr3 + +!=============================================================================== + +SUBROUTINE shr_mpi_sum(lvec,gvec,comm,string,all) + + IMPLICIT none + + !----- arguments --- + integer(SHR_KIND_IN), intent(in) :: lvec ! in/out local values + integer(SHR_KIND_IN), intent(out):: gvec ! in/out global values + integer(SHR_KIND_IN), intent(in) :: comm ! mpi communicator + character(*),optional,intent(in) :: string ! message + logical, optional,intent(in) :: all ! allreduce if true + !----- local ----- + character(*),parameter :: subName = '(shr_mpi_sumi0) ' + +!=============================================================================== +END SUBROUTINE shr_mpi_sum + +!=============================================================================== + +SUBROUTINE shr_mpi_commsize(comm,size,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + integer,intent(out) :: size + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_commsize) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI commsize +!------------------------------------------------------------------------------- + size = 1 + +END SUBROUTINE shr_mpi_commsize + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_commrank(comm,rank,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + integer,intent(out) :: rank + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_commrank) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI commrank +!------------------------------------------------------------------------------- + rank = 0 + +END SUBROUTINE shr_mpi_commrank + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_initialized(flag,string) + + IMPLICIT none + + !----- arguments --- + logical,intent(out) :: flag + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_initialized) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI initialized +!------------------------------------------------------------------------------- + flag = .true. + +END SUBROUTINE shr_mpi_initialized + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_abort(string,rcode) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + integer,optional,intent(in) :: rcode ! optional code + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_abort) ' + integer :: rc ! return code + +!------------------------------------------------------------------------------- +! PURPOSE: MPI abort +!------------------------------------------------------------------------------- + + if ( present(string) .and. present(rcode) ) then + write(s_logunit,*) trim(subName),":",trim(string),rcode + endif + if ( present(rcode) )then + rc = rcode + else + rc = 1001 + end if + stop + +END SUBROUTINE shr_mpi_abort + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_barrier(comm,string) + + IMPLICIT none + + !----- arguments --- + integer,intent(in) :: comm + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_barrier) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI barrier +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_barrier + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_init(string) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + + !----- local --- + character(*),parameter :: subName = '(shr_mpi_init) ' + +!------------------------------------------------------------------------------- +! PURPOSE: MPI init +!------------------------------------------------------------------------------- + +END SUBROUTINE shr_mpi_init + +!=============================================================================== +!=============================================================================== + +SUBROUTINE shr_mpi_finalize(string) + + IMPLICIT none + + !----- arguments --- + character(*),optional,intent(in) :: string ! message + + !----- local --- + +!------------------------------------------------------------------------------- +! PURPOSE: MPI finalize +!------------------------------------------------------------------------------- + if ( present(string) ) & + write(s_logunit,*) trim(string) + call shr_mpi_abort("MPI Finalize") + +END SUBROUTINE shr_mpi_finalize + +!=============================================================================== +!=============================================================================== + +END MODULE shr_mpi_mod From 1297aa10cf49deffe519e5d253a8e4c6db312559 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Jan 2026 14:43:37 -0700 Subject: [PATCH 5/7] Update src/main/test/decomp_test/test_decompMod.pf Co-authored-by: Samuel Levis --- src/main/test/decomp_test/test_decompMod.pf | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/test/decomp_test/test_decompMod.pf b/src/main/test/decomp_test/test_decompMod.pf index 6bef1690d5..a9c364dd64 100644 --- a/src/main/test/decomp_test/test_decompMod.pf +++ b/src/main/test/decomp_test/test_decompMod.pf @@ -43,7 +43,7 @@ contains class(TestDecompMod), intent(inout) :: this integer :: clump_pproc - ! TOTO: When decompMod has it's own allocate method that could be used here + ! TODO: When decompMod has it's own allocate method that could be used here nclumps = 1 clump_pproc = nclumps allocate(procinfo%cid(clump_pproc)) From e744db51bb78b1c74cf1329eddce4fde267fb2d5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Jan 2026 14:44:10 -0700 Subject: [PATCH 6/7] Update src/main/test/decomp_test/test_decompMod.pf Correction from review. Co-authored-by: Samuel Levis --- src/main/test/decomp_test/test_decompMod.pf | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/test/decomp_test/test_decompMod.pf b/src/main/test/decomp_test/test_decompMod.pf index a9c364dd64..8112e4c6ce 100644 --- a/src/main/test/decomp_test/test_decompMod.pf +++ b/src/main/test/decomp_test/test_decompMod.pf @@ -49,7 +49,7 @@ contains allocate(procinfo%cid(clump_pproc)) allocate(clumps(nclumps)) ! Set the procinfo and clumps values - ! TOD: Use initialization method when available (currently in decompInitMod) + ! TODO: Use initialization method when available (currently in decompInitMod) procinfo%cid = 1 procinfo%ncells = ni*nj procinfo%begg = 1 From 5ac060d3100e072a23b319b2e8de11dac1466c73 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Jan 2026 18:06:23 -0700 Subject: [PATCH 7/7] Remove the addition of FATES directories as it causes a fail on the first time it's built, you have to build it twice for it to work. I commented it out and added some notes around it --- src/CMakeLists.txt | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 52c8422055..67a8b32308 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -63,12 +63,16 @@ add_subdirectory(${CLM_ROOT}/src/init_interp clm_init_interp) add_subdirectory(${CLM_ROOT}/src/self_tests clm_self_tests) # Add FATES source directories -add_subdirectory(${CLM_ROOT}/src/fates/main fates_main) -add_subdirectory(${CLM_ROOT}/src/fates/biogeochem fates_biogeochem) -add_subdirectory(${CLM_ROOT}/src/fates/biogeophys fates_biogeophys) -add_subdirectory(${CLM_ROOT}/src/fates/parteh fates_parteh) -add_subdirectory(${CLM_ROOT}/src/fates/fire fates_fire) -add_subdirectory(${CLM_ROOT}/src/fates/radiation fates_radiation) +# Adding FATES directories is commented out -- because of the problem in: +# https://github.com/ESCOMP/CTSM/issues/3704 +# add_subdirectory(${CLM_ROOT}/src/fates/main fates_main) +# add_subdirectory(${CLM_ROOT}/src/fates/biogeochem fates_biogeochem) +# add_subdirectory(${CLM_ROOT}/src/fates/biogeophys fates_biogeophys) +# add_subdirectory(${CLM_ROOT}/src/fates/parteh fates_parteh) +# add_subdirectory(${CLM_ROOT}/src/fates/fire fates_fire) +# add_subdirectory(${CLM_ROOT}/src/fates/radiation fates_radiation) +# NOTE: Need to add the fates library and dependencies below +# ### End add of FATES directories # Add general unit test directories (stubbed out files, etc.) add_subdirectory(unit_test_stubs) @@ -105,9 +109,8 @@ endforeach() add_library(csm_share ${share_sources} ${drv_sources_needed}) declare_generated_dependencies(csm_share "${share_genf90_sources}") add_library(clm ${clm_sources}) -add_library(fates ${fates_sources}) declare_generated_dependencies(clm "${clm_genf90_sources}") -add_dependencies(clm csm_share ESMF fates) +add_dependencies(clm csm_share ESMF) # We need to look for header files here, in order to pick up shr_assert.h include_directories(${SRCROOT}/share/include)