Skip to content

Commit

Permalink
Refactor m_checker (#488)
Browse files Browse the repository at this point in the history
  • Loading branch information
ChrisZYJ authored Jun 28, 2024
1 parent 8956d74 commit ccc5054
Show file tree
Hide file tree
Showing 11 changed files with 1,593 additions and 2,083 deletions.
478 changes: 478 additions & 0 deletions src/common/m_checker_common.fpp

Large diffs are not rendered by default.

57 changes: 56 additions & 1 deletion src/common/m_helper.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,10 @@ module m_helper
f_create_bbox, &
s_print_2D_array, &
f_xor, &
f_logical_to_int
f_logical_to_int, &
f_approx_equal, &
f_is_default, &
f_all_default

contains

Expand Down Expand Up @@ -532,4 +535,56 @@ contains
end if
end function f_logical_to_int

!> This procedure checks if two floating point numbers of kind(0d0) are within tolerance.
!! @param a First number.
!! @param b Second number.
!! @param tol_input Relative error (default = 1d-6).
!! @return Result of the comparison.
logical function f_approx_equal(a, b, tol_input) result(res)
! Reference: https://floating-point-gui.de/errors/comparison/

real(kind(0d0)), intent(in) :: a, b
real(kind(0d0)), optional, intent(in) :: tol_input
real(kind(0d0)) :: tol

if (present(tol_input)) then
if (tol_input <= 0d0) then
call s_mpi_abort('tol_input must be positive. Exiting ...')
end if
tol = tol_input
else
tol = 1d-6
end if

if (a == b) then
res = .true.
else if (a == 0d0 .or. b == 0d0 .or. (abs(a) + abs(b) < tiny(a))) then
res = (abs(a - b) < (tol*tiny(a)))
else
res = (abs(a - b)/min(abs(a) + abs(b), huge(a)) < tol)
end if
end function f_approx_equal

!> Checks if a real(kind(0d0)) variable is of default value.
!! @param var Variable to check.
logical function f_is_default(var) result(res)
real(kind(0d0)), intent(in) :: var

res = f_approx_equal(var, dflt_real)
end function f_is_default

!> Checks if ALL elements of a real(kind(0d0)) array are of default value.
!! @param var_array Array to check.
logical function f_all_default(var_array) result(res)
real(kind(0d0)), intent(in) :: var_array(:)
logical :: res_array(size(var_array))
integer :: i

do i = 1, size(var_array)
res_array(i) = f_is_default(var_array(i))
end do

res = all(res_array)
end function f_all_default

end module m_helper
548 changes: 118 additions & 430 deletions src/post_process/m_checker.f90

Large diffs are not rendered by default.

3 changes: 3 additions & 0 deletions src/post_process/m_start_up.f90
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,8 @@ module m_start_up

use m_compile_specific

use m_checker_common

use m_checker
! ==========================================================================

Expand Down Expand Up @@ -131,6 +133,7 @@ subroutine s_check_input_file
'case_dir. Exiting ...')
end if

call s_check_inputs_common()
call s_check_inputs()

end subroutine s_check_input_file
Expand Down
Loading

0 comments on commit ccc5054

Please sign in to comment.