unit_test_r0 Subroutine

private subroutine unit_test_r0(this, res, expected, tol, msg, name, group)

Type Bound

unit_test

Arguments

Type IntentOptional Attributes Name
class(unit_test), intent(inout) :: this
real(kind=rk), intent(in) :: res
real(kind=rk), intent(in) :: expected
real(kind=rk), intent(in), optional :: tol
character(len=*), intent(in), optional :: msg
character(len=*), intent(in), optional :: name
character(len=*), intent(in), optional :: group

Calls

proc~~unit_test_r0~~CallsGraph proc~unit_test_r0 unit_test%unit_test_r0 proc~print_msg unit_test%print_msg proc~unit_test_r0->proc~print_msg colorize colorize proc~print_msg->colorize

Called by

proc~~unit_test_r0~~CalledByGraph proc~unit_test_r0 unit_test%unit_test_r0 none~check unit_test%check none~check->proc~unit_test_r0 program~demo_forunittest demo_forunittest program~demo_forunittest->none~check program~demo_old demo_old program~demo_old->none~check program~test1 test1 program~test1->none~check program~test2 test2 program~test2->none~check

Source Code

   subroutine unit_test_r0(this, res, expected, tol, msg, name, group)
      class(unit_test), intent(inout) :: this
      real(rk), intent(in) :: res, expected
      real(rk), intent(in), optional :: tol
      character(*), intent(in), optional :: msg
      character(len=*), optional, intent(in) :: name
      character(len=*), optional, intent(in) :: group
      real(rk) :: rel_err

      if (present(name)) then
         this%name = name
      else
         this%name = ''
      end if

      if (present(name)) then
         this%name = name
      else
         this%name = 'none'
      end if

      if (present(msg)) then
         this%msg = msg
      else
         this%msg = 'none'
      end if

      if (present(group)) then
         this%group = group
      else
         this%group = 'none'
      end if
      if (abs(expected)<=tiny(0.0_rk)) then
         rel_err = abs(res-expected)
      else
         rel_err = abs(res-expected)/abs(expected)
      end if

      if (present(tol)) then
         this%result = rel_err <= tol
      else
         ! this%result = rel_err == 0.0_rk
         this%result = abs(rel_err) <= 2.0_rk*epsilon(0.0_rk)
      end if

      call this%print_msg(this%result)
   end subroutine unit_test_r0