assert_allclose_real32_1d Function

public function assert_allclose_real32_1d(got, expect, test_name, rtol, print_result) result(test_pass)

Asserts that two real32-valued 1D arrays coincide to a given relative tolerance

Arguments

Type IntentOptional 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.)

Return Value logical

Did the assertion pass?


Source Code

    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