From d6e357ec9620fb3a5474b8943d6c70ea7e539280 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 26 Dec 2025 16:18:18 -0700 Subject: [PATCH 01/14] Add shr_wtracers_check_tracer_ratios --- src/water_isotopes/shr_wtracers_mod.F90 | 90 +++++++++++++++++++++++++ 1 file changed, 90 insertions(+) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index e630be1..a226edb 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -20,6 +20,7 @@ module shr_wtracers_mod use shr_log_mod , only : shr_log_error use shr_log_mod , only : s_logunit=>shr_log_Unit, s_loglev=>shr_log_Level use shr_string_mod , only : shr_string_listGetAllNames, shr_string_toUpper + use shr_infnan_mod , only : shr_infnan_isnan use shr_sys_mod , only : shr_sys_abort use nuopc_shr_methods , only : chkerr use NUOPC , only : NUOPC_CompAttributeGet @@ -42,6 +43,7 @@ module shr_wtracers_mod public :: shr_wtracers_get_species_name ! get the species name associated with a given tracer public :: shr_wtracers_is_isotope ! return true if a given tracer is an isotope public :: shr_wtracers_get_initial_ratio ! get the initial ratio for a given tracer + public :: shr_wtracers_check_tracer_ratios ! check tracer ratios against expectations !-------------------------------------------------------------------------- ! Private interfaces @@ -490,6 +492,94 @@ function shr_wtracers_get_initial_ratio(tracer_num) shr_wtracers_get_initial_ratio = tracer_initial_ratios(tracer_num) end function shr_wtracers_get_initial_ratio + !----------------------------------------------------------------------- + subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) + ! + ! !DESCRIPTION: Check tracer ratios (tracer/bulk) against expectations + ! + ! Aborts if any inconsistencies are found + ! + ! Should only be called in simulations set up to maintain constant water tracer + ! ratios: in general, water tracers will deviate from their initial, fixed ratios, + ! and so it makes no sense to perform these checks since they will always fail. + ! + ! !ARGUMENTS + real(r8), intent(in) :: tracers(:,:) ! dimensioned [tracerNum, gridcell] + real(r8), intent(in) :: bulk(:) + character(len=*), intent(in) :: name ! for diagnostic output + ! + ! !LOCAL VARIABLES + integer :: n, i + logical :: arrays_equal + integer :: diff_tracer, diff_loc + real(r8) :: val_bulk, val_tracer + + real(r8), parameter :: tolerance = 1.0e-7_r8 + + character(len=*), parameter :: subname='shr_wtracers_check_tracer_ratios' + !----------------------------------------------------------------------- + if (.not. water_tracers_initialized) then + call shr_sys_abort(subname//" ERROR: water tracers not yet initialized") + end if + if (size(tracers, 1) /= num_tracers) then + call shr_sys_abort(subname//" ERROR: unexpected number of tracers") + end if + if (size(tracers, 2) /= size(bulk)) then + call shr_sys_abort(subname//" ERROR: inconsistent sizes for tracers and bulk") + end if + + arrays_equal = .true. + tracer_loop: do n = 1, num_tracers + ! We may eventually want a mechanism to denote certain tracers as for-checking + ! and others not-for-checking (probably via another nuopc attribute parallel to + ! the other water tracers attributes). If we do, we could check that flag here + ! for tracer #n and go on to the next tracer if this is a not-for-checking + ! tracer. + + do i = 1, size(bulk) + if (.not. shr_infnan_isnan(bulk(i)) .and. .not. shr_infnan_isnan(tracers(n,i))) then + ! neither value is nan: check error tolerance + val_bulk = bulk(i) * tracer_initial_ratios(n) + val_tracer = tracers(n,i) + if (val_bulk == 0.0_r8 .and. val_tracer == 0.0_r8) then + ! trap special case where both are zero to avoid division by zero: values equal (do nothing) + else if (abs(val_bulk - val_tracer) / max(abs(val_bulk), abs(val_tracer)) > tolerance) then + arrays_equal = .false. + diff_tracer = n + diff_loc = i + exit tracer_loop + else + ! error < tolerance: values considered equal (do nothing) + end if + else if (shr_infnan_isnan(bulk(i)) .and. shr_infnan_isnan(tracers(n,i))) then + ! both values are nan: values are considered equal (do nothing) + else + ! only one value is nan: not equal + arrays_equal = .false. + diff_tracer = n + diff_loc = i + exit tracer_loop + end if + end do + end do tracer_loop + + if (.not. arrays_equal) then + write(s_logunit, '(A,A)') subname, " ERROR: tracer does not agree with bulk water" + write(s_logunit, '(A,A)') "Variable: ", trim(name) + write(s_logunit, '(A,I0,A,A)') "First difference found for tracer #", diff_tracer, & + ": ", tracer_names(diff_tracer) + write(s_logunit, '(A,I0)') "First difference at index: ", diff_loc + write(s_logunit, '(A, E25.17)') "Bulk : ", bulk(diff_loc) + write(s_logunit, '(A, E25.17)') "Tracer: ", tracers(diff_tracer, diff_loc) + write(s_logunit, '(A, E25.17)') "Expected ratio: ", tracer_initial_ratios(diff_tracer) + if (.not. shr_infnan_isnan(bulk(diff_loc))) then + write(s_logunit, '(A, E25.17)') "Bulk*ratio: ", bulk(diff_loc) * tracer_initial_ratios(diff_tracer) + end if + call shr_sys_abort(subname//" ERROR: tracer does not agree with bulk water") + end if + + end subroutine shr_wtracers_check_tracer_ratios + !----------------------------------------------------------------------- subroutine shr_wtracers_finalize(rc) ! From 00c3ad93ea0b8db5c01dd7ecacfd858a128064e6 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 29 Dec 2025 12:23:58 -0700 Subject: [PATCH 02/14] Add unit tests of shr_wtracers_check_tracer_ratios --- CMakeLists.txt | 4 +- src/CMakeLists.txt | 3 +- src/water_isotopes/CMakeLists.txt | 4 + src/water_isotopes/shr_wtracers_mod.F90 | 70 +++++++- test/unit/CMakeLists.txt | 4 +- test/unit/shr_wtracers_test/CMakeLists.txt | 29 +++ .../shr_wtracers_test/test_shr_wtracers.pf | 168 ++++++++++++++++++ unit_test_stubs/gptl/CMakeLists.txt | 6 + unit_test_stubs/gptl/README | 3 + unit_test_stubs/gptl/gptl.F90 | 12 ++ 10 files changed, 296 insertions(+), 7 deletions(-) create mode 100644 src/water_isotopes/CMakeLists.txt create mode 100644 test/unit/shr_wtracers_test/CMakeLists.txt create mode 100644 test/unit/shr_wtracers_test/test_shr_wtracers.pf create mode 100644 unit_test_stubs/gptl/CMakeLists.txt create mode 100644 unit_test_stubs/gptl/README create mode 100644 unit_test_stubs/gptl/gptl.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 093ad96..2d1c90d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -94,6 +94,7 @@ endif() # Among other things, this handles the genf90 generation add_subdirectory(src) +add_subdirectory(src/water_isotopes) file(GLOB FSOURCES "src/*.F90" "src/water_isotopes/*.F90" "RandNum/src/*.F90" "RandNum/src/*/*.F90") file(GLOB CSOURCES "src/*.c" "RandNum/src/*/*.c") @@ -110,6 +111,7 @@ target_include_directories(csm_share PRIVATE ${CMAKE_BINARY_DIR}) if(UNITTESTS) # need to turn the warning check off for pfunit set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wno-error ${CMAKE_Fortran_COMPILER_DIRECTIVE} -I${CMAKE_BINARY_DIR}/unittests/shr_assert_test/mod/assert/ ") - add_subdirectory(${CMAKE_SOURCE_DIR}/unit_test_stubs/util csm_share_stubs) + add_subdirectory(${CMAKE_SOURCE_DIR}/unit_test_stubs/util csm_share_stubs_util) + add_subdirectory(${CMAKE_SOURCE_DIR}/unit_test_stubs/gptl csm_share_stubs_gptl) add_subdirectory(${CMAKE_SOURCE_DIR}/test/unit ${CMAKE_BINARY_DIR}/unittests) endif() diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c15ddf8..a2228dd 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,7 +26,8 @@ list(APPEND share_sources shr_mpi_mod.F90 shr_pio_mod.F90 shr_wv_sat_mod.F90 - m_MergeSorts.F90) + m_MergeSorts.F90 + nuopc_shr_methods.F90) sourcelist_to_parent(share_sources) diff --git a/src/water_isotopes/CMakeLists.txt b/src/water_isotopes/CMakeLists.txt new file mode 100644 index 0000000..3784878 --- /dev/null +++ b/src/water_isotopes/CMakeLists.txt @@ -0,0 +1,4 @@ +list(APPEND share_sources + shr_wtracers_mod.F90) + +sourcelist_to_parent(share_sources) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index a226edb..d7ac873 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -35,7 +35,9 @@ module shr_wtracers_mod !-------------------------------------------------------------------------- public :: shr_wtracers_init ! initialize water tracer information + public :: shr_wtracers_init_directly_for_testing ! initialize water tracer information directly for the sake of unit testing public :: shr_wtracers_finalize ! finalize water tracer information + public :: shr_wtracers_initialized ! return true if this module has been initialized public :: shr_wtracers_present ! return true if there are water tracers in this simulation public :: shr_wtracers_get_num_tracers ! get number of water tracers in this simulation public :: shr_wtracers_get_name ! get the name of a given tracer @@ -127,6 +129,66 @@ subroutine shr_wtracers_init(driver, maintask, rc) end subroutine shr_wtracers_init + !----------------------------------------------------------------------- + subroutine shr_wtracers_init_directly_for_testing( & + water_tracer_names, water_tracer_species, water_tracer_initial_ratios, rc) + ! + ! !DESCRIPTION: + ! Initialize water tracer information directly for the sake of unit testing + ! + ! If there are any errors, an ESMF error code is returned in rc + ! + ! !ARGUMENTS + character(len=*), intent(in) :: water_tracer_names(:) + character(len=*), intent(in) :: water_tracer_species(:) ! expected to be uppercase + real(r8), intent(in) :: water_tracer_initial_ratios(:) + integer, intent(out) :: rc + ! + ! !LOCAL VARIABLES + character(len=*), parameter :: subname='shr_wtracers_init_directly_for_testing' + !--------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (water_tracers_initialized) then + call shr_log_error("Attempt to call "//subname//" multiple times", rc=rc) + return + end if + + num_tracers = size(water_tracer_names) + if (size(water_tracer_species) /= num_tracers .or. & + size(water_tracer_initial_ratios) /= num_tracers) then + call shr_log_error(subname//": Input array sizes disagree", rc=rc) + return + end if + + tracer_names = water_tracer_names + tracer_species_names = water_tracer_species + call shr_wtracers_set_species_types(rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + tracer_initial_ratios = water_tracer_initial_ratios + + water_tracers_initialized = .true. + + end subroutine shr_wtracers_init_directly_for_testing + + !----------------------------------------------------------------------- + function shr_wtracers_initialized() + ! + ! !DESCRIPTION: + ! Return true if this module has been initialized + ! + ! !ARGUMENTS + logical :: shr_wtracers_initialized ! function result + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname='shr_wtracers_initialized' + !----------------------------------------------------------------------- + + shr_wtracers_initialized = water_tracers_initialized + + end function shr_wtracers_initialized + !----------------------------------------------------------------------- subroutine shr_wtracers_parse_attributes(driver, rc) ! @@ -569,11 +631,11 @@ subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) write(s_logunit, '(A,I0,A,A)') "First difference found for tracer #", diff_tracer, & ": ", tracer_names(diff_tracer) write(s_logunit, '(A,I0)') "First difference at index: ", diff_loc - write(s_logunit, '(A, E25.17)') "Bulk : ", bulk(diff_loc) - write(s_logunit, '(A, E25.17)') "Tracer: ", tracers(diff_tracer, diff_loc) - write(s_logunit, '(A, E25.17)') "Expected ratio: ", tracer_initial_ratios(diff_tracer) + write(s_logunit, '(A, ES25.17)') "Bulk : ", bulk(diff_loc) + write(s_logunit, '(A, ES25.17)') "Tracer: ", tracers(diff_tracer, diff_loc) + write(s_logunit, '(A, ES25.17)') "Expected ratio: ", tracer_initial_ratios(diff_tracer) if (.not. shr_infnan_isnan(bulk(diff_loc))) then - write(s_logunit, '(A, E25.17)') "Bulk*ratio: ", bulk(diff_loc) * tracer_initial_ratios(diff_tracer) + write(s_logunit, '(A, ES25.17)') "Bulk*ratio: ", bulk(diff_loc) * tracer_initial_ratios(diff_tracer) end if call shr_sys_abort(subname//" ERROR: tracer does not agree with bulk water") end if diff --git a/test/unit/CMakeLists.txt b/test/unit/CMakeLists.txt index f86a859..105e98b 100644 --- a/test/unit/CMakeLists.txt +++ b/test/unit/CMakeLists.txt @@ -18,8 +18,10 @@ add_subdirectory(dynamic_vector) add_subdirectory(shr_vmath_test) +add_subdirectory(shr_wtracers_test) + add_subdirectory(shr_wv_sat_test) add_subdirectory(shr_precip_test) -add_subdirectory(shr_cal_test) \ No newline at end of file +add_subdirectory(shr_cal_test) diff --git a/test/unit/shr_wtracers_test/CMakeLists.txt b/test/unit/shr_wtracers_test/CMakeLists.txt new file mode 100644 index 0000000..d009043 --- /dev/null +++ b/test/unit/shr_wtracers_test/CMakeLists.txt @@ -0,0 +1,29 @@ +set (pf_sources + test_shr_wtracers.pf + ) + +set(sources_needed + shr_wtracers_mod.F90 + shr_assert_mod.F90 + shr_infnan_mod.F90 + shr_kind_mod.F90 + shr_log_mod.F90 + shr_strconvert_mod.F90 + shr_string_mod.F90 + shr_sys_mod.nompi_abortthrows.F90 + shr_abort_mod.abortthrows.F90 + shr_timer_mod.F90 + nuopc_shr_methods.F90 + gptl.F90) + +extract_sources("${sources_needed}" "${share_sources}" test_sources) + +add_pfunit_ctest(shr_wtracers + TEST_SOURCES "${pf_sources}" + OTHER_SOURCES "${test_sources}") + +declare_generated_dependencies(shr_wtracers "${share_genf90_sources}") + +target_link_libraries(shr_wtracers esmf) +# The following adds all dependencies of ESMF, including PIO, NetCDF, etc.: +target_link_libraries(shr_wtracers ESMF::ESMF) diff --git a/test/unit/shr_wtracers_test/test_shr_wtracers.pf b/test/unit/shr_wtracers_test/test_shr_wtracers.pf new file mode 100644 index 0000000..1c3802e --- /dev/null +++ b/test/unit/shr_wtracers_test/test_shr_wtracers.pf @@ -0,0 +1,168 @@ +module test_shr_wtracers + + ! Tests of shr_wtracers_mod + + use funit + use shr_wtracers_mod + use shr_kind_mod, only : r8=>SHR_KIND_R8 + use ESMF, only : ESMF_SUCCESS + + implicit none + + @TestCase + type, extends(TestCase) :: TestShrWtracers + contains + procedure :: setUp + procedure :: tearDown + end type TestShrWtracers + +contains + + subroutine setUp(this) + class(TestShrWtracers), intent(inout) :: this + end subroutine setUp + + subroutine tearDown(this) + class(TestShrWtracers), intent(inout) :: this + + integer :: rc + + if (shr_wtracers_initialized()) then + call shr_wtracers_finalize(rc) + end if + end subroutine tearDown + + ! ------------------------------------------------------------------------ + ! Tests of shr_wtracers_check_tracer_ratios + ! ------------------------------------------------------------------------ + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_both0(this) + ! The tracer ratio test should pass when both tracer and bulk are 0 + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = [2._r8, 2._r8, 2._r8], & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = 0._r8 + tracers(:,:) = 0._r8 + + ! The test passes if the following call runs successfully without aborting + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + end subroutine test_shr_wtracers_check_tracer_ratios_both0 + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_correct(this) + ! The tracer ratio test should pass when the tracer ratios are correct + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = [1._r8, 2._r8, 3._r8, 4._r8] + do i = 1, 3 + tracers(i,:) = ratios(i) * bulk(:) + end do + + ! The test passes if the following call runs successfully without aborting + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + end subroutine test_shr_wtracers_check_tracer_ratios_correct + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_differ(this) + ! The tracer ratio test should fail when some tracer ratio differs from expected + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = [1._r8, 2._r8, 3._r8, 4._r8] + do i = 1, 3 + tracers(i,:) = ratios(i) * bulk(:) + end do + tracers(2,3) = tracers(2,3) * 1.1_r8 + + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + end subroutine test_shr_wtracers_check_tracer_ratios_differ + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_tracer0(this) + ! The tracer ratio test should fail when some tracer value is zero despite non-zero bulk + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = [1._r8, 2._r8, 3._r8, 4._r8] + do i = 1, 3 + tracers(i,:) = ratios(i) * bulk(:) + end do + tracers(2,3) = 0._r8 + + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + end subroutine test_shr_wtracers_check_tracer_ratios_tracer0 + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_bulk0(this) + ! The tracer ratio test should fail when some bulk value is zero despite non-zero tracer + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = [1._r8, 2._r8, 3._r8, 4._r8] + do i = 1, 3 + tracers(i,:) = ratios(i) * bulk(:) + end do + bulk(3) = 0._r8 + + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + end subroutine test_shr_wtracers_check_tracer_ratios_bulk0 + +end module test_shr_wtracers diff --git a/unit_test_stubs/gptl/CMakeLists.txt b/unit_test_stubs/gptl/CMakeLists.txt new file mode 100644 index 0000000..466e5f5 --- /dev/null +++ b/unit_test_stubs/gptl/CMakeLists.txt @@ -0,0 +1,6 @@ +# In the real build, gptl would be a separate library. Here, for simplicity, we add the +# stub version of gptl to the share library. +list(APPEND share_sources + gptl.F90) + +sourcelist_to_parent(share_sources) diff --git a/unit_test_stubs/gptl/README b/unit_test_stubs/gptl/README new file mode 100644 index 0000000..5032e89 --- /dev/null +++ b/unit_test_stubs/gptl/README @@ -0,0 +1,3 @@ +This directory contains stubs of the gptl timing library. In real builds, we typically +link against a pre-built gptl. Here, for simplicity, we facilitate including the necessary +stubs in the share library so we can avoid linking against an actual gptl. diff --git a/unit_test_stubs/gptl/gptl.F90 b/unit_test_stubs/gptl/gptl.F90 new file mode 100644 index 0000000..398cef3 --- /dev/null +++ b/unit_test_stubs/gptl/gptl.F90 @@ -0,0 +1,12 @@ +! Stubs of the gptl timing library + +! Note that in the real gptl, these are defined in C. Here we define them in Fortran for +! simplicity, but keep them outside of a module for consistency with their usage (via an +! "external" statement rather than a "use" statement). + +function GPTLprint_memusage(msg) result(ierr) + character(len=*), intent(in) :: msg + integer :: ierr + + ierr = 0 +end function GPTLprint_memusage From 613224583ac216bcad49a980c2903b2fd6fcca26 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 29 Dec 2025 12:54:06 -0700 Subject: [PATCH 03/14] In the init-for-testing, set is_maintask to always true Since this is just used for unit testing, this is a reasonable setting. --- src/water_isotopes/shr_wtracers_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index be01513..cbb5d06 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -160,6 +160,8 @@ subroutine shr_wtracers_init_directly_for_testing( & return end if + is_maintask = .true. + num_tracers = size(water_tracer_names) if (size(water_tracer_species) /= num_tracers .or. & size(water_tracer_initial_ratios) /= num_tracers) then From 9d288e7f6fa9224f0c38194e62f8b05699fca0c2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 29 Dec 2025 17:04:14 -0700 Subject: [PATCH 04/14] Revert "In the init-for-testing, set is_maintask to always true" This reverts commit 613224583ac216bcad49a980c2903b2fd6fcca26. This needs to be reverted because I reverted b441fa67e8cbbfc7dad77917393d8b3e7f1168a4. --- src/water_isotopes/shr_wtracers_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index d806e99..6c7e1e9 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -155,8 +155,6 @@ subroutine shr_wtracers_init_directly_for_testing( & return end if - is_maintask = .true. - num_tracers = size(water_tracer_names) if (size(water_tracer_species) /= num_tracers .or. & size(water_tracer_initial_ratios) /= num_tracers) then From efdbd471a2d41678113c14a9d9e48f2f4c64fe65 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 24 Jan 2026 11:00:02 -0700 Subject: [PATCH 05/14] Fix formatting of a comment --- src/water_isotopes/shr_wtracers_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index 1b15156..db0a11d 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -598,7 +598,8 @@ end function shr_wtracers_get_initial_ratio !----------------------------------------------------------------------- subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) ! - ! !DESCRIPTION: Check tracer ratios (tracer/bulk) against expectations + ! !DESCRIPTION: + ! Check tracer ratios (tracer/bulk) against expectations ! ! Aborts if any inconsistencies are found ! From 5d6dd22eeaa738e76dcfd83eb13fe57b9d6e9048 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 24 Jan 2026 11:08:47 -0700 Subject: [PATCH 06/14] Introduce shr_wtracers_get_bulk_fieldname subroutine The main motivation for this is that we can then avoid a dependency on shr_string_withoutSuffix in CMEPS by wrapping / stubbing this new shr_wtracers subroutine. But this also has the benefit of making the intent more clear for callers of this (as compared with directly calling shr_string_withoutSuffix). --- src/water_isotopes/shr_wtracers_mod.F90 | 40 +++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index db0a11d..a21490f 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -40,6 +40,7 @@ module shr_wtracers_mod public :: shr_wtracers_finalize ! finalize water tracer information public :: shr_wtracers_initialized ! return true if this module has been initialized public :: shr_wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + public :: shr_wtracers_get_bulk_fieldname ! return the name of the equivalent bulk field corresponding to a water tracer field public :: shr_wtracers_present ! return true if there are water tracers in this simulation public :: shr_wtracers_get_num_tracers ! get number of water tracers in this simulation public :: shr_wtracers_get_name ! get the name of a given tracer @@ -452,6 +453,45 @@ function shr_wtracers_is_wtracer_field(fieldname) shr_wtracers_is_wtracer_field = is_tracer end function shr_wtracers_is_wtracer_field + !----------------------------------------------------------------------- + subroutine shr_wtracers_get_bulk_fieldname(fieldname, is_wtracer_field, bulk_fieldname) + ! + ! !DESCRIPTION: + ! Return the name of the equivalent bulk field corresponding to a water tracer field + ! + ! If fieldname is the name of a water tracer field, based on naming conventions, + ! then is_wtracer_field will be true and bulk_fieldname will hold the name of the + ! corresponding bulk field. + ! + ! If fieldname is *not* the name of a water tracer field, then is_wtracer_field will + ! be false, and bulk_fieldname will be the same as fieldname. + ! + ! Note that, unlike most other routines in this module, this function works even if + ! the data in this module has not been initialized (i.e., even if shr_wtracers_init + ! has not been called): it works simply based on naming conventions. + ! + ! !ARGUMENTS + character(len=*), intent(in) :: fieldname + logical , intent(out) :: is_wtracer_field + character(len=*), intent(out) :: bulk_fieldname + ! + ! !LOCAL VARIABLES: + integer :: localrc + + character(len=*), parameter :: subname='shr_wtracers_get_bulk_fieldname' + !----------------------------------------------------------------------- + + call shr_string_withoutSuffix( & + in_str = fieldname, & + suffix = WTRACERS_SUFFIX, & + has_suffix = is_wtracer_field, & + out_str = bulk_fieldname, & + rc = localrc) + if (localrc /= 0) then + call shr_sys_abort(subname//": ERROR in shr_string_withoutSuffix") + end if + end subroutine shr_wtracers_get_bulk_fieldname + !----------------------------------------------------------------------- function shr_wtracers_present() ! From fa78e0a2c3e98b05383a3d17a71ed41e97690508 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 10 Feb 2026 13:55:05 -0700 Subject: [PATCH 07/14] Add a version of shr_wtracers_check_tracer_ratios for 2-d arrays Written by Claude Code, reviewed by myself. --- src/water_isotopes/shr_wtracers_mod.F90 | 66 +++++++++++++++++-- .../shr_wtracers_test/test_shr_wtracers.pf | 63 ++++++++++++++++++ 2 files changed, 124 insertions(+), 5 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index a21490f..4093cbd 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -50,6 +50,11 @@ module shr_wtracers_mod public :: shr_wtracers_get_initial_ratio ! get the initial ratio for a given tracer public :: shr_wtracers_check_tracer_ratios ! check tracer ratios against expectations + interface shr_wtracers_check_tracer_ratios + module procedure shr_wtracers_check_tracer_ratios_1d + module procedure shr_wtracers_check_tracer_ratios_2d + end interface shr_wtracers_check_tracer_ratios + !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- @@ -636,7 +641,7 @@ function shr_wtracers_get_initial_ratio(tracer_num) end function shr_wtracers_get_initial_ratio !----------------------------------------------------------------------- - subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) + subroutine shr_wtracers_check_tracer_ratios_1d(tracers, bulk, name, extra_dim_index) ! ! !DESCRIPTION: ! Check tracer ratios (tracer/bulk) against expectations @@ -651,6 +656,7 @@ subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) real(r8), intent(in) :: tracers(:,:) ! dimensioned [tracerNum, gridcell] real(r8), intent(in) :: bulk(:) character(len=*), intent(in) :: name ! for diagnostic output + integer, intent(in), optional :: extra_dim_index ! index of extra dimension (for error messages) ! ! !LOCAL VARIABLES integer :: n, i @@ -660,7 +666,9 @@ subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) real(r8), parameter :: tolerance = 1.0e-7_r8 - character(len=*), parameter :: subname='shr_wtracers_check_tracer_ratios' + character(len=*), parameter :: subname='shr_wtracers_check_tracer_ratios_1d' + ! In some error messages, it makes more sense to print the generic name: + character(len=*), parameter :: subname_generic='shr_wtracers_check_tracer_ratios' !----------------------------------------------------------------------- if (.not. water_tracers_initialized) then call shr_sys_abort(subname//" ERROR: water tracers not yet initialized") @@ -708,8 +716,11 @@ subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) end do tracer_loop if (.not. arrays_equal) then - write(s_logunit, '(A,A)') subname, " ERROR: tracer does not agree with bulk water" + write(s_logunit, '(A,A)') subname_generic, " ERROR: tracer does not agree with bulk water" write(s_logunit, '(A,A)') "Variable: ", trim(name) + if (present(extra_dim_index)) then + write(s_logunit, '(A,I0)') "Extra dimension index: ", extra_dim_index + end if write(s_logunit, '(A,I0,A,A)') "First difference found for tracer #", diff_tracer, & ": ", tracer_names(diff_tracer) write(s_logunit, '(A,I0)') "First difference at index: ", diff_loc @@ -719,10 +730,55 @@ subroutine shr_wtracers_check_tracer_ratios(tracers, bulk, name) if (.not. shr_infnan_isnan(bulk(diff_loc))) then write(s_logunit, '(A, ES25.17)') "Bulk*ratio: ", bulk(diff_loc) * tracer_initial_ratios(diff_tracer) end if - call shr_sys_abort(subname//" ERROR: tracer does not agree with bulk water") + call shr_sys_abort(subname_generic//" ERROR: tracer does not agree with bulk water") end if - end subroutine shr_wtracers_check_tracer_ratios + end subroutine shr_wtracers_check_tracer_ratios_1d + + !----------------------------------------------------------------------- + subroutine shr_wtracers_check_tracer_ratios_2d(tracers, bulk, name) + ! + ! !DESCRIPTION: + ! Check tracer ratios (tracer/bulk) against expectations for 2-d bulk arrays + ! + ! This is a lightweight wrapper around shr_wtracers_check_tracer_ratios_1d that + ! loops over the first dimension of the bulk array. + ! + ! Aborts if any inconsistencies are found + ! + ! Should only be called in simulations set up to maintain constant water tracer + ! ratios: in general, water tracers will deviate from their initial, fixed ratios, + ! and so it makes no sense to perform these checks since they will always fail. + ! + ! !ARGUMENTS + real(r8), intent(in) :: tracers(:,:,:) ! dimensioned [tracerNum, ungriddedDim, gridcell] + real(r8), intent(in) :: bulk(:,:) ! dimensioned [ungriddedDim, gridcell] + character(len=*), intent(in) :: name ! for diagnostic output + ! + ! !LOCAL VARIABLES + integer :: i + + character(len=*), parameter :: subname='shr_wtracers_check_tracer_ratios_2d' + !----------------------------------------------------------------------- + if (.not. water_tracers_initialized) then + call shr_sys_abort(subname//" ERROR: water tracers not yet initialized") + end if + if (size(tracers, 1) /= num_tracers) then + call shr_sys_abort(subname//" ERROR: unexpected number of tracers") + end if + if (size(tracers, 2) /= size(bulk, 1)) then + call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 2 and bulk dim 1") + end if + if (size(tracers, 3) /= size(bulk, 2)) then + call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 3 and bulk dim 2") + end if + + do i = 1, size(bulk, 1) + call shr_wtracers_check_tracer_ratios_1d(tracers(:,i,:), bulk(i,:), name, & + extra_dim_index=i) + end do + + end subroutine shr_wtracers_check_tracer_ratios_2d !----------------------------------------------------------------------- subroutine shr_wtracers_finalize(rc) diff --git a/test/unit/shr_wtracers_test/test_shr_wtracers.pf b/test/unit/shr_wtracers_test/test_shr_wtracers.pf index 1c3802e..7739f49 100644 --- a/test/unit/shr_wtracers_test/test_shr_wtracers.pf +++ b/test/unit/shr_wtracers_test/test_shr_wtracers.pf @@ -165,4 +165,67 @@ contains @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") end subroutine test_shr_wtracers_check_tracer_ratios_bulk0 + ! ------------------------------------------------------------------------ + ! Tests of shr_wtracers_check_tracer_ratios with 2-d bulk arrays + ! ------------------------------------------------------------------------ + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_2d_correct(this) + ! The tracer ratio test should pass when the tracer ratios are correct (2-d bulk) + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(2, 4) + real(r8) :: tracers(3, 2, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i, j + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(1,:) = [1._r8, 2._r8, 3._r8, 4._r8] + bulk(2,:) = [5._r8, 6._r8, 7._r8, 8._r8] + do i = 1, 3 + do j = 1, 2 + tracers(i,j,:) = ratios(i) * bulk(j,:) + end do + end do + + ! The test passes if the following call runs successfully without aborting + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + end subroutine test_shr_wtracers_check_tracer_ratios_2d_correct + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_2d_differ(this) + ! The tracer ratio test should fail when some tracer ratio differs from expected (2-d bulk) + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(2, 4) + real(r8) :: tracers(3, 2, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i, j + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(1,:) = [1._r8, 2._r8, 3._r8, 4._r8] + bulk(2,:) = [5._r8, 6._r8, 7._r8, 8._r8] + do i = 1, 3 + do j = 1, 2 + tracers(i,j,:) = ratios(i) * bulk(j,:) + end do + end do + tracers(2,2,3) = tracers(2,2,3) * 1.1_r8 + + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + end subroutine test_shr_wtracers_check_tracer_ratios_2d_differ + end module test_shr_wtracers From 4952bdcc5b6eaf3e1540c19f9c9f8bfe54b685f1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 26 Feb 2026 15:03:36 -0700 Subject: [PATCH 08/14] Change dimension order convention for rank-3 tracer fields Since the naming convention is to have "_wtracers" last, we're also changing the dimension ordering convention to be consistent with that. --- src/water_isotopes/shr_wtracers_mod.F90 | 12 ++++++------ test/unit/shr_wtracers_test/test_shr_wtracers.pf | 8 ++++---- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index 4093cbd..e7c98b1 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -751,7 +751,7 @@ subroutine shr_wtracers_check_tracer_ratios_2d(tracers, bulk, name) ! and so it makes no sense to perform these checks since they will always fail. ! ! !ARGUMENTS - real(r8), intent(in) :: tracers(:,:,:) ! dimensioned [tracerNum, ungriddedDim, gridcell] + real(r8), intent(in) :: tracers(:,:,:) ! dimensioned [ungriddedDim, tracerNum, gridcell] real(r8), intent(in) :: bulk(:,:) ! dimensioned [ungriddedDim, gridcell] character(len=*), intent(in) :: name ! for diagnostic output ! @@ -763,18 +763,18 @@ subroutine shr_wtracers_check_tracer_ratios_2d(tracers, bulk, name) if (.not. water_tracers_initialized) then call shr_sys_abort(subname//" ERROR: water tracers not yet initialized") end if - if (size(tracers, 1) /= num_tracers) then - call shr_sys_abort(subname//" ERROR: unexpected number of tracers") + if (size(tracers, 1) /= size(bulk, 1)) then + call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 1 and bulk dim 1") end if - if (size(tracers, 2) /= size(bulk, 1)) then - call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 2 and bulk dim 1") + if (size(tracers, 2) /= num_tracers) then + call shr_sys_abort(subname//" ERROR: unexpected number of tracers") end if if (size(tracers, 3) /= size(bulk, 2)) then call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 3 and bulk dim 2") end if do i = 1, size(bulk, 1) - call shr_wtracers_check_tracer_ratios_1d(tracers(:,i,:), bulk(i,:), name, & + call shr_wtracers_check_tracer_ratios_1d(tracers(i,:,:), bulk(i,:), name, & extra_dim_index=i) end do diff --git a/test/unit/shr_wtracers_test/test_shr_wtracers.pf b/test/unit/shr_wtracers_test/test_shr_wtracers.pf index 7739f49..d4f6d9a 100644 --- a/test/unit/shr_wtracers_test/test_shr_wtracers.pf +++ b/test/unit/shr_wtracers_test/test_shr_wtracers.pf @@ -175,7 +175,7 @@ contains class(TestShrWtracers), intent(inout) :: this integer :: rc real(r8) :: bulk(2, 4) - real(r8) :: tracers(3, 2, 4) + real(r8) :: tracers(2, 3, 4) real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] integer :: i, j @@ -190,7 +190,7 @@ contains bulk(2,:) = [5._r8, 6._r8, 7._r8, 8._r8] do i = 1, 3 do j = 1, 2 - tracers(i,j,:) = ratios(i) * bulk(j,:) + tracers(j,i,:) = ratios(i) * bulk(j,:) end do end do @@ -204,7 +204,7 @@ contains class(TestShrWtracers), intent(inout) :: this integer :: rc real(r8) :: bulk(2, 4) - real(r8) :: tracers(3, 2, 4) + real(r8) :: tracers(2, 3, 4) real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] integer :: i, j @@ -219,7 +219,7 @@ contains bulk(2,:) = [5._r8, 6._r8, 7._r8, 8._r8] do i = 1, 3 do j = 1, 2 - tracers(i,j,:) = ratios(i) * bulk(j,:) + tracers(j,i,:) = ratios(i) * bulk(j,:) end do end do tracers(2,2,3) = tracers(2,2,3) * 1.1_r8 From b234928489a514bd2f53957ad4c4b85cfaa1e7b7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 4 Mar 2026 18:35:09 -0700 Subject: [PATCH 09/14] Simplify conditional for tracer consistency check By changing a division to a multiplication we can remove the pre-check for values being 0. Thanks to Keith Lindsay for the suggestion. --- src/water_isotopes/shr_wtracers_mod.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index e7c98b1..37f6281 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -693,15 +693,11 @@ subroutine shr_wtracers_check_tracer_ratios_1d(tracers, bulk, name, extra_dim_in ! neither value is nan: check error tolerance val_bulk = bulk(i) * tracer_initial_ratios(n) val_tracer = tracers(n,i) - if (val_bulk == 0.0_r8 .and. val_tracer == 0.0_r8) then - ! trap special case where both are zero to avoid division by zero: values equal (do nothing) - else if (abs(val_bulk - val_tracer) / max(abs(val_bulk), abs(val_tracer)) > tolerance) then + if (abs(val_bulk - val_tracer) > tolerance * max(abs(val_bulk), abs(val_tracer))) then arrays_equal = .false. diff_tracer = n diff_loc = i exit tracer_loop - else - ! error < tolerance: values considered equal (do nothing) end if else if (shr_infnan_isnan(bulk(i)) .and. shr_infnan_isnan(tracers(n,i))) then ! both values are nan: values are considered equal (do nothing) From cd982020cc5b9ce2a64f5c604c5ddd160013ea64 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 31 Mar 2026 07:06:12 -0600 Subject: [PATCH 10/14] Only print water tracer information if shr_log_level > 0 --- src/water_isotopes/shr_wtracers_mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index 37f6281..acbd9bf 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -19,6 +19,7 @@ module shr_wtracers_mod use shr_kind_mod , only : CS=>SHR_KIND_CS, CM=>SHR_KIND_CM, CXX=>SHR_KIND_CXX use shr_log_mod , only : shr_log_error use shr_log_mod , only : s_logunit=>shr_log_Unit + use shr_log_mod , only : s_loglev=>shr_log_Level use shr_string_mod , only : shr_string_listGetAllNames, shr_string_toUpper use shr_string_mod , only : shr_string_withoutSuffix use shr_infnan_mod , only : shr_infnan_isnan @@ -132,8 +133,10 @@ subroutine shr_wtracers_init(driver, maintask, rc) water_tracers_initialized = .true. - call shr_wtracers_print(maintask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (s_loglev > 0) then + call shr_wtracers_print(maintask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end subroutine shr_wtracers_init From fa2465857f7cf012c0a8eccb7d516778de61d26e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 17 Apr 2026 17:11:31 -0600 Subject: [PATCH 11/14] Add unit tests of NaN handling in water tracer checks Written by Claude, reviewed by myself. --- .../shr_wtracers_test/test_shr_wtracers.pf | 56 +++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/test/unit/shr_wtracers_test/test_shr_wtracers.pf b/test/unit/shr_wtracers_test/test_shr_wtracers.pf index d4f6d9a..43cd005 100644 --- a/test/unit/shr_wtracers_test/test_shr_wtracers.pf +++ b/test/unit/shr_wtracers_test/test_shr_wtracers.pf @@ -5,6 +5,7 @@ module test_shr_wtracers use funit use shr_wtracers_mod use shr_kind_mod, only : r8=>SHR_KIND_R8 + use shr_infnan_mod, only : assignment(=), nan => shr_infnan_nan use ESMF, only : ESMF_SUCCESS implicit none @@ -165,6 +166,61 @@ contains @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") end subroutine test_shr_wtracers_check_tracer_ratios_bulk0 + @Test + subroutine test_shr_wtracers_check_tracer_ratios_bothnan(this) + ! The tracer ratio test should pass when both tracer and bulk are NaN + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = [1._r8, 2._r8, 3._r8, 4._r8] + do i = 1, 3 + tracers(i,:) = ratios(i) * bulk(:) + end do + bulk(3) = nan + tracers(:,3) = nan + + ! The test passes if the following call runs successfully without aborting + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + end subroutine test_shr_wtracers_check_tracer_ratios_bothnan + + @Test + subroutine test_shr_wtracers_check_tracer_ratios_tracernan(this) + ! The tracer ratio test should fail when some tracer value is NaN despite non-NaN bulk + class(TestShrWtracers), intent(inout) :: this + integer :: rc + real(r8) :: bulk(4) + real(r8) :: tracers(3, 4) + real(r8), parameter :: ratios(3) = [2._r8, 3._r8, 4._r8] + integer :: i + + call shr_wtracers_init_directly_for_testing( & + water_tracer_names = ["tracer1", "tracer2", "tracer3"], & + water_tracer_species = [WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK, WATER_SPECIES_NAME_BULK], & + water_tracer_initial_ratios = ratios, & + rc = rc) + @assertEqual(ESMF_SUCCESS, rc) + + bulk(:) = [1._r8, 2._r8, 3._r8, 4._r8] + do i = 1, 3 + tracers(i,:) = ratios(i) * bulk(:) + end do + tracers(2,3) = nan + + call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + end subroutine test_shr_wtracers_check_tracer_ratios_tracernan + ! ------------------------------------------------------------------------ ! Tests of shr_wtracers_check_tracer_ratios with 2-d bulk arrays ! ------------------------------------------------------------------------ From c8b712b73efa64fab481b3e39d27728e3c1b69b2 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 13 May 2026 17:36:48 -0600 Subject: [PATCH 12/14] Add more info to shr_aborts from shr_wtracers_mod Claude made the changes, I gave them a cursory review. --- src/water_isotopes/shr_wtracers_mod.F90 | 58 +++++++++++++++---- .../shr_wtracers_test/test_shr_wtracers.pf | 10 ++-- 2 files changed, 51 insertions(+), 17 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index acbd9bf..9d43fdf 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -417,15 +417,21 @@ subroutine shr_wtracers_check_tracer_num(tracer_num, subname) ! !ARGUMENTS integer, intent(in) :: tracer_num character(len=*), intent(in) :: subname ! name of the caller, for error message + ! + ! !LOCAL VARIABLES + character(len=CXX) :: msg !----------------------------------------------------------------------- if (tracer_num < 1 .or. tracer_num > num_tracers) then - write(s_logunit, '(A,I0)') subname//" ERROR: tracer_num out of range: ", tracer_num if (num_tracers == 0) then - write(s_logunit, '(A)') "(This simulation has no tracers.)" + write(msg, '(A,I0,A)') & + subname//" ERROR: tracer_num out of range: ", tracer_num, & + " (This simulation has no tracers.)" else - write(s_logunit, '(A,I0,A)') "(Valid range: 1 - ", num_tracers, ".)" + write(msg, '(A,I0,A,I0,A)') & + subname//" ERROR: tracer_num out of range: ", tracer_num, & + " (Valid range: 1 - ", num_tracers, ")" end if - call shr_sys_abort(subname//" ERROR: tracer_num out of range") + call shr_sys_abort(trim(msg)) end if end subroutine shr_wtracers_check_tracer_num @@ -446,6 +452,7 @@ function shr_wtracers_is_wtracer_field(fieldname) ! !LOCAL VARIABLES: integer :: localrc logical :: is_tracer + character(len=CXX) :: msg character(len=*), parameter :: subname='shr_wtracers_is_wtracer_field' !----------------------------------------------------------------------- @@ -456,7 +463,10 @@ function shr_wtracers_is_wtracer_field(fieldname) has_suffix = is_tracer, & rc = localrc) if (localrc /= 0) then - call shr_sys_abort(subname//": ERROR in shr_string_withoutSuffix") + write(msg, '(A,I0)') & + subname//": ERROR in shr_string_withoutSuffix for fieldname '"// & + trim(fieldname)//"', localrc = ", localrc + call shr_sys_abort(trim(msg)) end if shr_wtracers_is_wtracer_field = is_tracer end function shr_wtracers_is_wtracer_field @@ -485,6 +495,7 @@ subroutine shr_wtracers_get_bulk_fieldname(fieldname, is_wtracer_field, bulk_fie ! ! !LOCAL VARIABLES: integer :: localrc + character(len=CXX) :: msg character(len=*), parameter :: subname='shr_wtracers_get_bulk_fieldname' !----------------------------------------------------------------------- @@ -496,7 +507,10 @@ subroutine shr_wtracers_get_bulk_fieldname(fieldname, is_wtracer_field, bulk_fie out_str = bulk_fieldname, & rc = localrc) if (localrc /= 0) then - call shr_sys_abort(subname//": ERROR in shr_string_withoutSuffix") + write(msg, '(A,I0)') & + subname//": ERROR in shr_string_withoutSuffix for fieldname '"// & + trim(fieldname)//"', localrc = ", localrc + call shr_sys_abort(trim(msg)) end if end subroutine shr_wtracers_get_bulk_fieldname @@ -666,6 +680,7 @@ subroutine shr_wtracers_check_tracer_ratios_1d(tracers, bulk, name, extra_dim_in logical :: arrays_equal integer :: diff_tracer, diff_loc real(r8) :: val_bulk, val_tracer + character(len=CXX) :: msg real(r8), parameter :: tolerance = 1.0e-7_r8 @@ -677,10 +692,16 @@ subroutine shr_wtracers_check_tracer_ratios_1d(tracers, bulk, name, extra_dim_in call shr_sys_abort(subname//" ERROR: water tracers not yet initialized") end if if (size(tracers, 1) /= num_tracers) then - call shr_sys_abort(subname//" ERROR: unexpected number of tracers") + write(msg, '(A,I0,A,I0)') & + subname//" ERROR: unexpected number of tracers: size(tracers, 1) = ", & + size(tracers, 1), ", num_tracers = ", num_tracers + call shr_sys_abort(trim(msg)) end if if (size(tracers, 2) /= size(bulk)) then - call shr_sys_abort(subname//" ERROR: inconsistent sizes for tracers and bulk") + write(msg, '(A,I0,A,I0)') & + subname//" ERROR: inconsistent sizes for tracers and bulk: size(tracers, 2) = ", & + size(tracers, 2), ", size(bulk) = ", size(bulk) + call shr_sys_abort(trim(msg)) end if arrays_equal = .true. @@ -729,7 +750,10 @@ subroutine shr_wtracers_check_tracer_ratios_1d(tracers, bulk, name, extra_dim_in if (.not. shr_infnan_isnan(bulk(diff_loc))) then write(s_logunit, '(A, ES25.17)') "Bulk*ratio: ", bulk(diff_loc) * tracer_initial_ratios(diff_tracer) end if - call shr_sys_abort(subname_generic//" ERROR: tracer does not agree with bulk water") + write(msg, '(A,I0)') & + subname_generic//" ERROR: tracer does not agree with bulk water for variable '"// & + trim(name)//"', tracer '"//trim(tracer_names(diff_tracer))//"', at index ", diff_loc + call shr_sys_abort(trim(msg)) end if end subroutine shr_wtracers_check_tracer_ratios_1d @@ -756,6 +780,7 @@ subroutine shr_wtracers_check_tracer_ratios_2d(tracers, bulk, name) ! ! !LOCAL VARIABLES integer :: i + character(len=CXX) :: msg character(len=*), parameter :: subname='shr_wtracers_check_tracer_ratios_2d' !----------------------------------------------------------------------- @@ -763,13 +788,22 @@ subroutine shr_wtracers_check_tracer_ratios_2d(tracers, bulk, name) call shr_sys_abort(subname//" ERROR: water tracers not yet initialized") end if if (size(tracers, 1) /= size(bulk, 1)) then - call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 1 and bulk dim 1") + write(msg, '(A,I0,A,I0)') & + subname//" ERROR: inconsistent size for tracers dim 1 and bulk dim 1: size(tracers, 1) = ", & + size(tracers, 1), ", size(bulk, 1) = ", size(bulk, 1) + call shr_sys_abort(trim(msg)) end if if (size(tracers, 2) /= num_tracers) then - call shr_sys_abort(subname//" ERROR: unexpected number of tracers") + write(msg, '(A,I0,A,I0)') & + subname//" ERROR: unexpected number of tracers: size(tracers, 2) = ", & + size(tracers, 2), ", num_tracers = ", num_tracers + call shr_sys_abort(trim(msg)) end if if (size(tracers, 3) /= size(bulk, 2)) then - call shr_sys_abort(subname//" ERROR: inconsistent size for tracers dim 3 and bulk dim 2") + write(msg, '(A,I0,A,I0)') & + subname//" ERROR: inconsistent size for tracers dim 3 and bulk dim 2: size(tracers, 3) = ", & + size(tracers, 3), ", size(bulk, 2) = ", size(bulk, 2) + call shr_sys_abort(trim(msg)) end if do i = 1, size(bulk, 1) diff --git a/test/unit/shr_wtracers_test/test_shr_wtracers.pf b/test/unit/shr_wtracers_test/test_shr_wtracers.pf index 43cd005..66d2c6a 100644 --- a/test/unit/shr_wtracers_test/test_shr_wtracers.pf +++ b/test/unit/shr_wtracers_test/test_shr_wtracers.pf @@ -109,7 +109,7 @@ contains tracers(2,3) = tracers(2,3) * 1.1_r8 call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") - @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water for variable 'test', tracer 'tracer2', at index 3") end subroutine test_shr_wtracers_check_tracer_ratios_differ @Test @@ -136,7 +136,7 @@ contains tracers(2,3) = 0._r8 call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") - @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water for variable 'test', tracer 'tracer2', at index 3") end subroutine test_shr_wtracers_check_tracer_ratios_tracer0 @Test @@ -163,7 +163,7 @@ contains bulk(3) = 0._r8 call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") - @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water for variable 'test', tracer 'tracer1', at index 3") end subroutine test_shr_wtracers_check_tracer_ratios_bulk0 @Test @@ -218,7 +218,7 @@ contains tracers(2,3) = nan call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") - @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water for variable 'test', tracer 'tracer2', at index 3") end subroutine test_shr_wtracers_check_tracer_ratios_tracernan ! ------------------------------------------------------------------------ @@ -281,7 +281,7 @@ contains tracers(2,2,3) = tracers(2,2,3) * 1.1_r8 call shr_wtracers_check_tracer_ratios(tracers, bulk, "test") - @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water") + @assertExceptionRaised("ABORTED: shr_wtracers_check_tracer_ratios ERROR: tracer does not agree with bulk water for variable 'test', tracer 'tracer2', at index 3") end subroutine test_shr_wtracers_check_tracer_ratios_2d_differ end module test_shr_wtracers From d4c56a01445314dc0b72b1261cfb828a3d1f3063 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 14 May 2026 14:24:59 -0600 Subject: [PATCH 13/14] Add "only" clause to "use shr_wtracers_mod" in unit tests --- test/unit/shr_wtracers_test/test_shr_wtracers.pf | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/test/unit/shr_wtracers_test/test_shr_wtracers.pf b/test/unit/shr_wtracers_test/test_shr_wtracers.pf index 66d2c6a..620c8a2 100644 --- a/test/unit/shr_wtracers_test/test_shr_wtracers.pf +++ b/test/unit/shr_wtracers_test/test_shr_wtracers.pf @@ -3,7 +3,12 @@ module test_shr_wtracers ! Tests of shr_wtracers_mod use funit - use shr_wtracers_mod + + use shr_wtracers_mod, only : shr_wtracers_initialized, shr_wtracers_finalize + use shr_wtracers_mod, only : shr_wtracers_init_directly_for_testing + use shr_wtracers_mod, only : shr_wtracers_check_tracer_ratios + use shr_wtracers_mod, only : WATER_SPECIES_NAME_BULK + use shr_kind_mod, only : r8=>SHR_KIND_R8 use shr_infnan_mod, only : assignment(=), nan => shr_infnan_nan use ESMF, only : ESMF_SUCCESS From c322156b3f7c2008102086c59fb07030eb343768 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 14 May 2026 15:39:18 -0600 Subject: [PATCH 14/14] CXX seems like overkill for msg variables; use CX to save some memory --- src/water_isotopes/shr_wtracers_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/water_isotopes/shr_wtracers_mod.F90 b/src/water_isotopes/shr_wtracers_mod.F90 index 9d43fdf..3e73f5e 100644 --- a/src/water_isotopes/shr_wtracers_mod.F90 +++ b/src/water_isotopes/shr_wtracers_mod.F90 @@ -16,7 +16,7 @@ module shr_wtracers_mod !--------------------------------------------------------------------- use shr_kind_mod , only : r8=>SHR_KIND_R8 - use shr_kind_mod , only : CS=>SHR_KIND_CS, CM=>SHR_KIND_CM, CXX=>SHR_KIND_CXX + use shr_kind_mod , only : CS=>SHR_KIND_CS, CM=>SHR_KIND_CM, CX=>SHR_KIND_CX, CXX=>SHR_KIND_CXX use shr_log_mod , only : shr_log_error use shr_log_mod , only : s_logunit=>shr_log_Unit use shr_log_mod , only : s_loglev=>shr_log_Level @@ -419,7 +419,7 @@ subroutine shr_wtracers_check_tracer_num(tracer_num, subname) character(len=*), intent(in) :: subname ! name of the caller, for error message ! ! !LOCAL VARIABLES - character(len=CXX) :: msg + character(len=CX) :: msg !----------------------------------------------------------------------- if (tracer_num < 1 .or. tracer_num > num_tracers) then if (num_tracers == 0) then @@ -452,7 +452,7 @@ function shr_wtracers_is_wtracer_field(fieldname) ! !LOCAL VARIABLES: integer :: localrc logical :: is_tracer - character(len=CXX) :: msg + character(len=CX) :: msg character(len=*), parameter :: subname='shr_wtracers_is_wtracer_field' !----------------------------------------------------------------------- @@ -495,7 +495,7 @@ subroutine shr_wtracers_get_bulk_fieldname(fieldname, is_wtracer_field, bulk_fie ! ! !LOCAL VARIABLES: integer :: localrc - character(len=CXX) :: msg + character(len=CX) :: msg character(len=*), parameter :: subname='shr_wtracers_get_bulk_fieldname' !----------------------------------------------------------------------- @@ -680,7 +680,7 @@ subroutine shr_wtracers_check_tracer_ratios_1d(tracers, bulk, name, extra_dim_in logical :: arrays_equal integer :: diff_tracer, diff_loc real(r8) :: val_bulk, val_tracer - character(len=CXX) :: msg + character(len=CX) :: msg real(r8), parameter :: tolerance = 1.0e-7_r8 @@ -780,7 +780,7 @@ subroutine shr_wtracers_check_tracer_ratios_2d(tracers, bulk, name) ! ! !LOCAL VARIABLES integer :: i - character(len=CXX) :: msg + character(len=CX) :: msg character(len=*), parameter :: subname='shr_wtracers_check_tracer_ratios_2d' !-----------------------------------------------------------------------