From 09b3ee0398ffc00535cd77c3f26445772fdaaa29 Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Wed, 2 Apr 2025 14:46:40 +0200 Subject: [PATCH 1/9] Add simple error handling and assertion module --- src/utilities/CMakeLists.txt | 3 +- src/utilities/error_handling.f90 | 135 +++++++++++++++++++++++++++++++ 2 files changed, 137 insertions(+), 1 deletion(-) create mode 100644 src/utilities/error_handling.f90 diff --git a/src/utilities/CMakeLists.txt b/src/utilities/CMakeLists.txt index 3796371..f510ab5 100644 --- a/src/utilities/CMakeLists.txt +++ b/src/utilities/CMakeLists.txt @@ -1,2 +1,3 @@ list(APPEND SOURCES - ${CMAKE_CURRENT_LIST_DIR}/uemep_logger.f90) \ No newline at end of file + ${CMAKE_CURRENT_LIST_DIR}/uemep_logger.f90 + ${CMAKE_CURRENT_LIST_DIR}/error_handling.f90) \ No newline at end of file diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 new file mode 100644 index 0000000..46957ea --- /dev/null +++ b/src/utilities/error_handling.f90 @@ -0,0 +1,135 @@ +module error_handling + + !! This module provides general error handling, checking, and assertion procedures + !! + !! Copyright (C) 2007 Free Software Foundation. + !! License GNU LGPL-3.0 . + !! This is free software: you are free to change and redistribute it. + !! + !! Developed and maintained at the Norwegian Meteorological Institute. + !! Contribute at: + + use uEMEP_definitions, only: unit_logfile + use uemep_constants, only: dp + + implicit none + + private + + ! Error codes + integer, parameter, public :: no_error = 0 + integer, parameter, public :: default_error = -1 + + ! Precision tolerances + real, parameter, public :: tol_real = 1.0e-5 + real, parameter, public :: tol_dp = 1.0e-12 + + ! Public interfaces + public :: assert, check_equality + + interface assert + !! Asserts a condition, and raises an error if violated + module procedure assert_true + end interface + + interface check_equality + !! Checks if two values are equal within precision tolerances + module procedure check_equality_integer + module procedure check_equality_real + module procedure check_equality_dp + end interface check_equality + + interface is_between + !! Checks if a value is between a minimum and maximum threshold (min <= value <= max) + module procedure is_between_integer + module procedure is_between_real + module procedure is_between_dp + end interface is_between + +contains + + subroutine print_error(message) + !! Writes an error message to the log + character(len=*), intent(in) :: message + + write(unit_logfile, "(3a)") "ERROR: ", message + end subroutine print_error + + logical function check_equality_integer(first_value, second_value) result(are_equal) + !! Compares two integers for equality + integer, intent(in) :: first_value + integer, intent(in) :: second_value + + are_equal = (first_value == second_value) + end function check_equality_integer + + logical function check_equality_real(first_value, second_value) result(are_equal) + !! Compares two single precision reals for equality within a set tolerance + real, intent(in) :: first_value + real, intent(in) :: second_value + + are_equal = (abs(second_value - first_value) <= tol_real) + end function check_equality_real + + logical function check_equality_dp(first_value, second_value) result(are_equal) + !! Compares two double precision reals for equality within a set tolerance + real(dp), intent(in) :: first_value + real(dp), intent(in) :: second_value + + are_equal = (abs(second_value - first_value) <= tol_dp) + end function check_equality_dp + + logical function is_between_integer(value, min_threshold, max_threshold) result(is_within_range) + !! Checks if an integer value is between a minimum and maximum threshold (min <= value <= max) + integer, intent(in) :: value + integer, intent(in) :: min_threshold + integer, intent(in) :: max_threshold + + call assert((min_threshold > max_threshold), "Minimum threshold cannot exceed maximum threshold") + is_within_range = (value >= min_threshold .and. value <= max_threshold) + end function is_between_integer + + logical function is_between_real(value, min_threshold, max_threshold) result(is_within_range) + !! Checks if a real value is between a minimum and maximum threshold (min <= value <= max) + real, intent(in) :: value + real, intent(in) :: min_threshold + real, intent(in) :: max_threshold + + call assert((min_threshold > max_threshold), "Minimum threshold cannot exceed maximum threshold") + is_within_range = (value >= min_threshold .and. value <= max_threshold) + end function is_between_real + + logical function is_between_dp(value, min_threshold, max_threshold) result(is_within_range) + !! Checks if a double precision real value is between a minimum and maximum threshold (min <= value <= max) + real(dp), intent(in) :: value + real(dp), intent(in) :: min_threshold + real(dp), intent(in) :: max_threshold + + call assert((min_threshold > max_threshold), "Minimum threshold cannot exceed maximum threshold") + is_within_range = (value >= min_threshold .and. value <= max_threshold) + end function is_between_dp + + subroutine assert_true(condition, message, code) + !! Asserts a condition and terminates with an error message and code if violated + logical, intent(in) :: condition + character(len=*), intent(in), optional :: message + integer, intent(in), optional :: code + + integer :: error_code + if (.not. condition) then + if (present(code)) then + error_code = code + else + error_code = default_error + end if + + if (present(message)) then + call print_error(message) + else + call print_error("Assertion failed!") + end if + stop error_code + end if + end subroutine assert_true + +end module error_handling \ No newline at end of file From 3fb1a6ccb4b21970a642b99c99677b4fa92cfd41 Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Wed, 2 Apr 2025 16:19:05 +0200 Subject: [PATCH 2/9] Add additional error codes --- src/utilities/error_handling.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index 46957ea..368e02f 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -19,6 +19,8 @@ module error_handling ! Error codes integer, parameter, public :: no_error = 0 integer, parameter, public :: default_error = -1 + integer, parameter, public :: file_not_found = -2 + integer, parameter, public :: read_error = -3 ! Precision tolerances real, parameter, public :: tol_real = 1.0e-5 From c57c66cc8de4f3d30f01168fc85c374871a1e781 Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Wed, 2 Apr 2025 16:30:11 +0200 Subject: [PATCH 3/9] Add procedure to assert error codes --- src/utilities/error_handling.f90 | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index 368e02f..8e37bd7 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -32,6 +32,7 @@ module error_handling interface assert !! Asserts a condition, and raises an error if violated module procedure assert_true + module procedure assert_code end interface interface check_equality @@ -134,4 +135,28 @@ subroutine assert_true(condition, message, code) end if end subroutine assert_true + subroutine assert_code(code, message, no_error_code) + !! Asserts the error code, and terminates with an error message if different from no_error + integer, intent(in) :: code + character(len=*), intent(in), optional :: message + integer, intent(in), optional :: no_error_code + + logical :: assert_condition + + integer :: local_error_code + if (present(no_error_code)) then + local_error_code = no_error_code + else + local_error_code = no_error + end if + + assert_condition = check_equality(code, local_error_code) + + if (present(message)) then + call assert(assert_condition, message, code) + else + call assert(assert_condition, code=code) + end if + end subroutine assert_code + end module error_handling \ No newline at end of file From 14c319656a60ee521d28a64bb7f7e697b64bd60f Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Mon, 7 Apr 2025 11:46:37 +0200 Subject: [PATCH 4/9] Add additional error codes --- src/utilities/error_handling.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index 8e37bd7..e79c26e 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -21,13 +21,16 @@ module error_handling integer, parameter, public :: default_error = -1 integer, parameter, public :: file_not_found = -2 integer, parameter, public :: read_error = -3 + integer, parameter, public :: index_error = -4 + integer, parameter, public :: allocation_error = -5 + integer, parameter, public :: invalid_value = -6 ! Precision tolerances real, parameter, public :: tol_real = 1.0e-5 real, parameter, public :: tol_dp = 1.0e-12 ! Public interfaces - public :: assert, check_equality + public :: assert, check_equality, is_between interface assert !! Asserts a condition, and raises an error if violated From 0bd1515dbe85a37af8f74dd9ecbd46f992211728 Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Tue, 21 Oct 2025 15:05:55 +0200 Subject: [PATCH 5/9] Update error codes --- src/utilities/error_handling.f90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index e79c26e..d7b7502 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -21,9 +21,13 @@ module error_handling integer, parameter, public :: default_error = -1 integer, parameter, public :: file_not_found = -2 integer, parameter, public :: read_error = -3 - integer, parameter, public :: index_error = -4 - integer, parameter, public :: allocation_error = -5 - integer, parameter, public :: invalid_value = -6 + integer, parameter, public :: write_error = -4 + integer, parameter, public :: index_error = -5 + integer, parameter, public :: allocation_error = -6 + integer, parameter, public :: invalid_value = -7 + integer, parameter, public :: division_error = -8 + integer, parameter, public :: config_error = -9 + integer, parameter, public :: not_implemented = -10 ! Precision tolerances real, parameter, public :: tol_real = 1.0e-5 From 54641de6b28b19be23a4b9ef55ce3c993dedb403 Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Tue, 21 Oct 2025 15:23:53 +0200 Subject: [PATCH 6/9] Fix assertion logic in threshold comparison --- src/utilities/error_handling.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index d7b7502..11ec4dc 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -95,7 +95,7 @@ logical function is_between_integer(value, min_threshold, max_threshold) result( integer, intent(in) :: min_threshold integer, intent(in) :: max_threshold - call assert((min_threshold > max_threshold), "Minimum threshold cannot exceed maximum threshold") + call assert((min_threshold <= max_threshold), "Minimum threshold cannot exceed maximum threshold") is_within_range = (value >= min_threshold .and. value <= max_threshold) end function is_between_integer @@ -105,7 +105,7 @@ logical function is_between_real(value, min_threshold, max_threshold) result(is_ real, intent(in) :: min_threshold real, intent(in) :: max_threshold - call assert((min_threshold > max_threshold), "Minimum threshold cannot exceed maximum threshold") + call assert((min_threshold <= max_threshold), "Minimum threshold cannot exceed maximum threshold") is_within_range = (value >= min_threshold .and. value <= max_threshold) end function is_between_real @@ -115,7 +115,7 @@ logical function is_between_dp(value, min_threshold, max_threshold) result(is_wi real(dp), intent(in) :: min_threshold real(dp), intent(in) :: max_threshold - call assert((min_threshold > max_threshold), "Minimum threshold cannot exceed maximum threshold") + call assert((min_threshold <= max_threshold), "Minimum threshold cannot exceed maximum threshold") is_within_range = (value >= min_threshold .and. value <= max_threshold) end function is_between_dp From 57dec2434b0883efc9fcfa72f04b94850498873d Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Tue, 21 Oct 2025 15:24:37 +0200 Subject: [PATCH 7/9] Fix dp value declaration --- src/utilities/error_handling.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index 11ec4dc..2af39fb 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -31,7 +31,7 @@ module error_handling ! Precision tolerances real, parameter, public :: tol_real = 1.0e-5 - real, parameter, public :: tol_dp = 1.0e-12 + real(dp), parameter, public :: tol_dp = 1.0e-12_dp ! Public interfaces public :: assert, check_equality, is_between From 258a98450cd80d8f9e50a798d09c82429248702f Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Tue, 21 Oct 2025 15:25:41 +0200 Subject: [PATCH 8/9] Fix format specifier for print_error --- src/utilities/error_handling.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index 2af39fb..0fd4ccc 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -62,7 +62,7 @@ subroutine print_error(message) !! Writes an error message to the log character(len=*), intent(in) :: message - write(unit_logfile, "(3a)") "ERROR: ", message + write(unit_logfile, "(2a)") "ERROR: ", message end subroutine print_error logical function check_equality_integer(first_value, second_value) result(are_equal) From d0ea53e2bfc399ff1ce0e4e6bc191459b3ddff1b Mon Sep 17 00:00:00 2001 From: Erik Askov Mousing <10355482+eamousing@users.noreply.github.com> Date: Fri, 5 Jun 2026 11:24:03 +0000 Subject: [PATCH 9/9] chore: simplified error_handling module --- src/utilities/error_handling.f90 | 46 ++++---------------------------- 1 file changed, 5 insertions(+), 41 deletions(-) diff --git a/src/utilities/error_handling.f90 b/src/utilities/error_handling.f90 index 0fd4ccc..df53e3e 100644 --- a/src/utilities/error_handling.f90 +++ b/src/utilities/error_handling.f90 @@ -1,6 +1,6 @@ module error_handling - !! This module provides general error handling, checking, and assertion procedures + !! This module provides simple error handling, checking, and assertion procedures !! !! Copyright (C) 2007 Free Software Foundation. !! License GNU LGPL-3.0 . @@ -18,16 +18,7 @@ module error_handling ! Error codes integer, parameter, public :: no_error = 0 - integer, parameter, public :: default_error = -1 - integer, parameter, public :: file_not_found = -2 - integer, parameter, public :: read_error = -3 - integer, parameter, public :: write_error = -4 - integer, parameter, public :: index_error = -5 - integer, parameter, public :: allocation_error = -6 - integer, parameter, public :: invalid_value = -7 - integer, parameter, public :: division_error = -8 - integer, parameter, public :: config_error = -9 - integer, parameter, public :: not_implemented = -10 + integer, parameter, public :: default_error = 1 ! Precision tolerances real, parameter, public :: tol_real = 1.0e-5 @@ -39,7 +30,6 @@ module error_handling interface assert !! Asserts a condition, and raises an error if violated module procedure assert_true - module procedure assert_code end interface interface check_equality @@ -78,7 +68,7 @@ logical function check_equality_real(first_value, second_value) result(are_equal real, intent(in) :: first_value real, intent(in) :: second_value - are_equal = (abs(second_value - first_value) <= tol_real) + are_equal = (abs(second_value - first_value) <= tol_real * max(1.0, abs(first_value), abs(second_value))) end function check_equality_real logical function check_equality_dp(first_value, second_value) result(are_equal) @@ -86,7 +76,7 @@ logical function check_equality_dp(first_value, second_value) result(are_equal) real(dp), intent(in) :: first_value real(dp), intent(in) :: second_value - are_equal = (abs(second_value - first_value) <= tol_dp) + are_equal = (abs(second_value - first_value) <= tol_dp * max(1.0_dp, abs(first_value), abs(second_value))) end function check_equality_dp logical function is_between_integer(value, min_threshold, max_threshold) result(is_within_range) @@ -95,7 +85,6 @@ logical function is_between_integer(value, min_threshold, max_threshold) result( integer, intent(in) :: min_threshold integer, intent(in) :: max_threshold - call assert((min_threshold <= max_threshold), "Minimum threshold cannot exceed maximum threshold") is_within_range = (value >= min_threshold .and. value <= max_threshold) end function is_between_integer @@ -105,7 +94,6 @@ logical function is_between_real(value, min_threshold, max_threshold) result(is_ real, intent(in) :: min_threshold real, intent(in) :: max_threshold - call assert((min_threshold <= max_threshold), "Minimum threshold cannot exceed maximum threshold") is_within_range = (value >= min_threshold .and. value <= max_threshold) end function is_between_real @@ -115,7 +103,6 @@ logical function is_between_dp(value, min_threshold, max_threshold) result(is_wi real(dp), intent(in) :: min_threshold real(dp), intent(in) :: max_threshold - call assert((min_threshold <= max_threshold), "Minimum threshold cannot exceed maximum threshold") is_within_range = (value >= min_threshold .and. value <= max_threshold) end function is_between_dp @@ -138,32 +125,9 @@ subroutine assert_true(condition, message, code) else call print_error("Assertion failed!") end if + flush(unit_logfile) stop error_code end if end subroutine assert_true - subroutine assert_code(code, message, no_error_code) - !! Asserts the error code, and terminates with an error message if different from no_error - integer, intent(in) :: code - character(len=*), intent(in), optional :: message - integer, intent(in), optional :: no_error_code - - logical :: assert_condition - - integer :: local_error_code - if (present(no_error_code)) then - local_error_code = no_error_code - else - local_error_code = no_error - end if - - assert_condition = check_equality(code, local_error_code) - - if (present(message)) then - call assert(assert_condition, message, code) - else - call assert(assert_condition, code=code) - end if - end subroutine assert_code - end module error_handling \ No newline at end of file