Asserts that two real32-valued 1D arrays coincide to a given relative tolerance
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=real32), | intent(in), | dimension(:) | :: | got |
The array of values to be tested |
|
real(kind=real32), | intent(in), | dimension(:) | :: | expect |
The array of expected values |
|
character(len=*), | intent(in) | :: | test_name |
Name of the test being run |
||
real(kind=real32), | intent(in), | optional | :: | rtol |
Optional relative tolerance (defaults to 1e-5) |
|
logical, | intent(in), | optional | :: | print_result |
Optionally print test result to screen (defaults to .true.) |
Did the assertion pass?
function assert_allclose_real32_1d(got, expect, test_name, rtol, print_result) result(test_pass) character(len=*), intent(in) :: test_name !! Name of the test being run real(kind=real32), intent(in), dimension(:) :: got !! The array of values to be tested real(kind=real32), intent(in), dimension(:) :: expect !! The array of expected values real(kind=real32), intent(in), optional :: rtol !! Optional relative tolerance (defaults to 1e-5) logical, intent(in), optional :: print_result !! Optionally print test result to screen (defaults to .true.) logical :: test_pass !! Did the assertion pass? character(len=80) :: message real(kind=real32) :: relative_error real(kind=real32) :: rtol_value integer :: shape_error logical :: print_result_value if (.not. present(rtol)) then rtol_value = 1.0e-5 else rtol_value = rtol end if if (.not. present(print_result)) then print_result_value = .true. else print_result_value = print_result end if ! Check the shapes of the arrays match shape_error = maxval(abs(shape(got) - shape(expect))) test_pass = (shape_error == 0) if (test_pass) then test_pass = all(abs(got - expect) <= rtol_value * abs(expect)) if (print_result_value) then write(message,'("relative tolerance = ", E11.4)') rtol_value call test_print(test_name, message, test_pass) end if else if (print_result_value) then call test_print(test_name, "Arrays have mismatching shapes.", test_pass) endif end function assert_allclose_real32_1d