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..df53e3e --- /dev/null +++ b/src/utilities/error_handling.f90 @@ -0,0 +1,133 @@ +module error_handling + + !! This module provides simple 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(dp), parameter, public :: tol_dp = 1.0e-12_dp + + ! Public interfaces + public :: assert, check_equality, is_between + + 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, "(2a)") "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 * 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) + !! 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 * 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) + !! 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 + + 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 + + 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 + + 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 + flush(unit_logfile) + stop error_code + end if + end subroutine assert_true + +end module error_handling \ No newline at end of file