forked from ESCOMP/CTSM
-
Notifications
You must be signed in to change notification settings - Fork 3
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request ESCOMP#13 from NCAR/truncate_h2osfc
Truncate small h2osfc values to zero This replaces the earlier code that only did this truncation in one particular circumstance. This seems mainly important to truncate small negative numbers to 0, but it also seems like a good idea to truncate small positive numbers that should have been 0. With some intermediate commits on this branch, I did some careful tests to ensure that these diffs introduce no more than roundoff-level changes.
- Loading branch information
Showing
7 changed files
with
246 additions
and
36 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,89 @@ | ||
| module NumericsMod | ||
|
|
||
| !----------------------------------------------------------------------- | ||
| ! !DESCRIPTION: | ||
| ! Utility routines for assisting with model numerics | ||
| ! | ||
| ! !USES: | ||
| #include "shr_assert.h" | ||
| use shr_kind_mod , only : r8 => shr_kind_r8 | ||
| use shr_log_mod , only : errMsg => shr_log_errMsg | ||
|
|
||
| implicit none | ||
| save | ||
| private | ||
|
|
||
| ! !PUBLIC MEMBER FUNCTIONS: | ||
| public :: truncate_small_values ! Truncate relatively small values to 0 | ||
|
|
||
| ! !PUBLIC MEMBER DATA: | ||
|
|
||
| ! Relative differences below rel_epsilon are considered to be zero. | ||
| ! | ||
| ! Note that double precision machine epsilon is approximately 1e-16, so this value of | ||
| ! 1e-13 allows for 3 orders of magnitude of "slop". | ||
| ! | ||
| ! Examples of how to use this: | ||
| ! | ||
| ! (1) Rather than checking | ||
| ! if (x == y) | ||
| ! instead check | ||
| ! if (abs(x - y) < rel_epsilon * x) | ||
| ! or | ||
| ! if (abs(x - y) < rel_epsilon * y) | ||
| ! | ||
| ! (2) After a state update, you can truncate the state to 0 based on this condition: | ||
| ! if (abs(some_state) < rel_epsilon * abs(some_state_orig)) then | ||
| ! some_state = 0._r8 | ||
| ! end if | ||
| ! where some_state_orig is the value of the state variable before the update | ||
| real(r8), public, parameter :: rel_epsilon = 1.e-13_r8 ! Relative differences below this are considered to be zero | ||
|
|
||
| ! !PRIVATE MEMBER DATA: | ||
|
|
||
| character(len=*), parameter, private :: sourcefile = & | ||
| __FILE__ | ||
|
|
||
| contains | ||
|
|
||
| !----------------------------------------------------------------------- | ||
| subroutine truncate_small_values(num_f, filter_f, lb, ub, data_baseline, data) | ||
| ! | ||
| ! !DESCRIPTION: | ||
| ! Truncate relatively small values to 0, within the given filter. | ||
| ! | ||
| ! "Relatively small" is determined by comparison with some "baseline" version of the | ||
| ! data. | ||
| ! | ||
| ! For example, this can be used after doing a state update. In this case, | ||
| ! data_baseline should hold the values before the state update, and data should hold | ||
| ! the values after the state update. | ||
| ! | ||
| ! !ARGUMENTS: | ||
| integer , intent(in) :: num_f ! number of points in filter_f | ||
| integer , intent(in) :: filter_f(:) ! filter of points in data | ||
| integer , intent(in) :: lb ! lower bound of data | ||
| integer , intent(in) :: ub ! upper bound of data | ||
| real(r8) , intent(in) :: data_baseline(lb:) ! baseline version of data, used to define "relatively close to 0" | ||
| real(r8) , intent(inout) :: data(lb:) ! data to operate on | ||
| ! | ||
| ! !LOCAL VARIABLES: | ||
| integer :: fn ! index into filter | ||
| integer :: n ! index into data | ||
|
|
||
| character(len=*), parameter :: subname = 'truncate_small_values' | ||
| !----------------------------------------------------------------------- | ||
|
|
||
| SHR_ASSERT_ALL((ubound(data_baseline) == (/ub/)), errMsg(sourcefile, __LINE__)) | ||
| SHR_ASSERT_ALL((ubound(data) == (/ub/)), errMsg(sourcefile, __LINE__)) | ||
|
|
||
| do fn = 1, num_f | ||
| n = filter_f(fn) | ||
| if (abs(data(n)) < rel_epsilon * abs(data_baseline(n))) then | ||
| data(n) = 0._r8 | ||
| end if | ||
| end do | ||
|
|
||
| end subroutine truncate_small_values | ||
|
|
||
| end module NumericsMod |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,2 +1,3 @@ | ||
| add_subdirectory(clm_time_manager_test) | ||
| add_subdirectory(annual_flux_dribbler_test) | ||
| add_subdirectory(annual_flux_dribbler_test) | ||
| add_subdirectory(numerics_test) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,10 @@ | ||
| set (pfunit_sources | ||
| test_truncate_small_values.pf) | ||
|
|
||
| set (extra_sources | ||
| ) | ||
|
|
||
| create_pFUnit_test(numerics test_numerics_exe | ||
| "${pfunit_sources}" "${extra_sources}") | ||
|
|
||
| target_link_libraries(test_numerics_exe clm csm_share esmf_wrf_timemgr) |
120 changes: 120 additions & 0 deletions
120
src/utils/test/numerics_test/test_truncate_small_values.pf
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,120 @@ | ||
| module test_truncate_small_values | ||
|
|
||
| ! Tests of NumericsMod: truncate_small_values | ||
|
|
||
| use pfunit_mod | ||
| use NumericsMod | ||
| use shr_kind_mod , only : r8 => shr_kind_r8 | ||
| use unittestSimpleSubgridSetupsMod | ||
| use unittestSubgridMod | ||
| use unittestFilterBuilderMod, only : filter_from_range | ||
|
|
||
| implicit none | ||
|
|
||
| @TestCase | ||
| type, extends(TestCase) :: TestTSV | ||
| contains | ||
| procedure :: setUp | ||
| procedure :: tearDown | ||
| end type TestTSV | ||
|
|
||
| real(r8), parameter :: tol = 1.e-13_r8 | ||
|
|
||
| contains | ||
|
|
||
| subroutine setUp(this) | ||
| class(TestTSV), intent(inout) :: this | ||
| end subroutine setUp | ||
|
|
||
| subroutine tearDown(this) | ||
| class(TestTSV), intent(inout) :: this | ||
|
|
||
| call unittest_subgrid_teardown() | ||
| end subroutine tearDown | ||
|
|
||
| @Test | ||
| subroutine truncates_correct_points(this) | ||
| class(TestTSV), intent(inout) :: this | ||
| real(r8) :: data_baseline(3) | ||
| real(r8) :: data(3) | ||
| real(r8) :: data_saved(3) | ||
| integer :: num_f | ||
| integer, allocatable :: filter_f(:) | ||
|
|
||
| call setup_n_veg_patches(pwtcol = [0.1_r8, 0.8_r8, 0.1_r8], pft_types = [1, 2, 3]) | ||
| call filter_from_range(bounds%begp, bounds%endp, num_f, filter_f) | ||
|
|
||
| ! point 2 should be truncated, others should not be truncated | ||
| data_baseline = [1._r8, 1._r8, 1._r8] | ||
| data = [0.5_r8, 1.e-16_r8, -1._r8] | ||
| data_saved = data | ||
|
|
||
| call truncate_small_values( & | ||
| num_f = num_f, & | ||
| filter_f = filter_f, & | ||
| lb = bounds%begp, & | ||
| ub = bounds%endp, & | ||
| data_baseline = data_baseline, & | ||
| data = data) | ||
|
|
||
| @assertEqual(data_saved(1), data(1)) | ||
| @assertEqual(data_saved(3), data(3)) | ||
| @assertEqual(0._r8, data(2)) | ||
|
|
||
| end subroutine truncates_correct_points | ||
|
|
||
| @Test | ||
| subroutine truncates_large_magnitude(this) | ||
| ! Make sure we're just relying on relative rather than absolute magnitudes by | ||
| ! confirming that it can truncate a value with large magnitude. | ||
| class(TestTSV), intent(inout) :: this | ||
| real(r8) :: data_baseline(1) | ||
| real(r8) :: data(1) | ||
| integer :: num_f | ||
| integer, allocatable :: filter_f(:) | ||
|
|
||
| call setup_single_veg_patch(pft_type = 1) | ||
| call filter_from_range(bounds%begp, bounds%endp, num_f, filter_f) | ||
|
|
||
| data_baseline = [1.e30_r8] | ||
| data = [1.e10_r8] | ||
|
|
||
| call truncate_small_values( & | ||
| num_f = num_f, & | ||
| filter_f = filter_f, & | ||
| lb = bounds%begp, & | ||
| ub = bounds%endp, & | ||
| data_baseline = data_baseline, & | ||
| data = data) | ||
|
|
||
| @assertEqual(0._r8, data(1)) | ||
| end subroutine truncates_large_magnitude | ||
|
|
||
| @Test | ||
| subroutine does_not_truncate_small_magnitude(this) | ||
| ! Make sure we're just relying on relative rather than absolute magnitudes by | ||
| ! confirming that it does not truncate a value with small magnitude. | ||
| class(TestTSV), intent(inout) :: this | ||
| real(r8) :: data_baseline(1) | ||
| real(r8) :: data(1) | ||
| integer :: num_f | ||
| integer, allocatable :: filter_f(:) | ||
|
|
||
| call setup_single_veg_patch(pft_type = 1) | ||
| call filter_from_range(bounds%begp, bounds%endp, num_f, filter_f) | ||
|
|
||
| data_baseline = [1.e-30_r8] | ||
| data = [1.e-31_r8] | ||
|
|
||
| call truncate_small_values( & | ||
| num_f = num_f, & | ||
| filter_f = filter_f, & | ||
| lb = bounds%begp, & | ||
| ub = bounds%endp, & | ||
| data_baseline = data_baseline, & | ||
| data = data) | ||
|
|
||
| @assertEqual(1.e-31_r8, data(1)) | ||
| end subroutine does_not_truncate_small_magnitude | ||
|
|
||
| end module test_truncate_small_values |