tem_float_test Program

Uses

  • program~~tem_float_test~~UsesGraph program~tem_float_test tem_float_test module~env_module env_module program~tem_float_test->module~env_module module~tem_float_module tem_float_module program~tem_float_test->module~tem_float_module mpi mpi module~env_module->mpi module~flu_binding flu_binding module~env_module->module~flu_binding iso_fortran_env iso_fortran_env module~env_module->iso_fortran_env module~aotus_module aotus_module module~env_module->module~aotus_module module~tem_float_module->module~env_module

Calls

program~~tem_float_test~~CallsGraph program~tem_float_test tem_float_test proc~checktest checkTest program~tem_float_test->proc~checktest

Contents

Source Code


Variables

Type AttributesNameInitial
real(kind=rk) :: testvalue
real(kind=rk) :: testarray(2)
logical :: res =.true.

Subroutines

subroutine checkTest(res, msg)

Arguments

Type IntentOptional AttributesName
logical, intent(in) :: res
character(len=*), intent(in) :: msg

Source Code

program tem_float_test

  use env_module,       only: rk
  use tem_float_module, only: operator(.feq.), &
    &                         operator(.fne.), &
    &                         operator(.fgt.), &
    &                         operator(.fge.), &
    &                         operator(.flt.), &
    &                         operator(.fle.)

  implicit none

  real(kind=rk) :: testvalue
  real(kind=rk) :: testarray(2)
  logical :: res = .true.

  write(*,*) 'testvalue = 0._rk'
  testvalue = 0._rk
  testarray = (/ 0._rk, 1._rk /)

  ! 0 == 0
  res = res .and. (testvalue .feq. testvalue)
  call checkTest(res, '(testvalue .feq. testvalue)')
  ! 0 != 0 + something very small
  res = res .and..not. (testvalue .feq. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .feq. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue-spacing(testvalue)))')
  ! 0 + something very small != 0
  res = res .and..not. ((testvalue+spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .feq. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .feq. testvalue)')

  ! (0,1) == (0,1)
  res = res .and. (testarray .feq. testarray)
  call checkTest(res, '(testarray .feq. testarray)')

  ! !0 != 0
  res = res .and..not. (testvalue .fne. testvalue)
  call checkTest(res, '.not. (testvalue .fnq. testvalue)')
  ! !0 == 0 + something very small
  res = res .and. (testvalue .fne. (testvalue+spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue+spacing(testvalue)))')
  res = res .and. (testvalue .fne. (testvalue-spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue-spacing(testvalue)))')
  ! !0 + something very small == 0
  res = res .and. ((testvalue+spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue+spacing(testvalue)) .fne. testvalue)')
  res = res .and. ((testvalue-spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue-spacing(testvalue)) .fne. testvalue)')

  ! (0,1) != (0,1)
  res = res .and..not. (testarray .fne. testarray)
  call checkTest(res, '.not. (testarray .fne. testarray)')

  ! 0 lt 0 + something very small
  res = res .and. (testvalue .flt. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .flt. (testvalue+spacing(testvalue)))')
  ! 0 !gt 0 + something very small
  res = res .and..not. (testvalue .fgt. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fgt. (testvalue+spacing(testvalue)))')
  ! 0 + something very small !lt 0
  res = res .and..not. ((testvalue+spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .flt. testvalue)')
  ! 0 + something very small gt 0
  res = res .and. ((testvalue+spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fgt. testvalue)')
  ! 0 !lt 0 - something very small
  res = res .and..not. (testvalue .flt. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .flt. (testvalue-spacing(testvalue)))')
  ! 0 gt 0 - something very small
  res = res .and. (testvalue .fgt. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fgt. (testvalue-spacing(testvalue)))')
  ! 0 - something very small lt 0
  res = res .and. ((testvalue-spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .flt. testvalue)')
  ! 0 - something very small !gt 0
  res = res .and..not. ((testvalue-spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fgt. testvalue)')

  ! 0 lte 0
  res = res .and. (testvalue .fle. testvalue)
  call checkTest(res, '(testvalue .fle. testvalue)')
  ! 0 lge 0
  res = res .and. (testvalue .fge. testvalue)
  call checkTest(res, '(testvalue .fge. testvalue)')
  ! 0 lte 0 + something very small
  res = res .and. (testvalue .fle. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .fle. (testvalue+spacing(testvalue)))')
  ! 0 !gte 0 + something very small
  res = res .and..not. (testvalue .fge. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fge. (testvalue+spacing(testvalue)))')
  ! 0 + something very small !lte 0
  res = res .and..not. ((testvalue+spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .fle. testvalue)')
  ! 0 + something very small gte 0
  res = res .and. ((testvalue+spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fge. testvalue)')
  ! 0 !lte 0 - something very small
  res = res .and..not. (testvalue .fle. (testvalue-spacing(testvalue)))
  call checkTest(res, '..not. (testvalue .fle. (testvalue-spacing(testvalue)))')
  ! 0 gte 0 - something very small
  res = res .and. (testvalue .fge. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fge. (testvalue-spacing(testvalue)))')
  ! 0 - something very small lte 0
  res = res .and. ((testvalue-spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .fle. testvalue)')
  ! 0 - something very small !gte 0
  res = res .and..not. ((testvalue-spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fge. testvalue)')

  ! The same with huge
  write(*,*) 'testvalue = huge(0._rk)'
  testvalue = huge(0._rk)
  res = res .and. (testvalue .feq. testvalue)
  call checkTest(res, '(testvalue .feq. testvalue)')
  res = res .and..not. (testvalue .feq. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue-spacing(testvalue)))')
  res = res .and..not. ((testvalue-spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .feq. testvalue)')

  res = res .and..not. (testvalue .fne. testvalue)
  call checkTest(res, '.not. (testvalue .fnq. testvalue)')
  res = res .and. (testvalue .fne. (testvalue-spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue-spacing(testvalue)) .fne. testvalue)')

  res = res .and..not. (testvalue .flt. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .flt. (testvalue-spacing(testvalue)))')
  res = res .and. (testvalue .fgt. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fgt. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .flt. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fgt. testvalue)')

  res = res .and. (testvalue .fle. testvalue)
  call checkTest(res, '(testvalue .fle. testvalue)')
  res = res .and. (testvalue .fge. testvalue)
  call checkTest(res, '(testvalue .fge. testvalue)')
  res = res .and..not. (testvalue .fle. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fle. (testvalue-spacing(testvalue)))')
  res = res .and. (testvalue .fge. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fge. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .fle. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fge. testvalue)')

  ! and now with tiny
  write(*,*) 'testvalue = tiny(0._rk)'
  testvalue = tiny(0._rk)
  res = res .and. (testvalue .feq. testvalue)
  call checkTest(res, '(testvalue .feq. testvalue)')
  res = res .and..not. (testvalue .feq. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .feq. testvalue)')

  res = res .and..not. (testvalue .fne. testvalue)
  call checkTest(res, '.not. (testvalue .fnq. testvalue)')
  res = res .and. (testvalue .fne. (testvalue+spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue+spacing(testvalue)))')
  res = res .and. (testvalue .fne. (testvalue-spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue+spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue+spacing(testvalue)) .fne. testvalue)')
  res = res .and. ((testvalue-spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue-spacing(testvalue)) .fne. testvalue)')

  res = res .and. (testvalue .flt. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .flt. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .fgt. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fgt. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .flt. testvalue)')
  res = res .and. ((testvalue+spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fgt. testvalue)')

  res = res .and. (testvalue .fle. testvalue)
  call checkTest(res, '(testvalue .fle. testvalue)')
  res = res .and. (testvalue .fge. testvalue)
  call checkTest(res, '(testvalue .fge. testvalue)')
  res = res .and. (testvalue .fle. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .fle. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .fge. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fge. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .fle. testvalue)')
  res = res .and. ((testvalue+spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fge. testvalue)')

  ! Now with some rather big value
  write(*,*) 'testvalue = 1234567890_rk * 10**9'
  testvalue = 1234567890_rk * 10**9
  res = res .and. (testvalue .feq. testvalue)
  call checkTest(res, '(testvalue .feq. testvalue)')
  res = res .and..not. (testvalue .feq. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .feq. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue-spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .feq. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .feq. testvalue)')

  res = res .and..not. (testvalue .fne. testvalue)
  call checkTest(res, '.not. (testvalue .fnq. testvalue)')
  res = res .and. (testvalue .fne. (testvalue+spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue+spacing(testvalue)))')
  res = res .and. (testvalue .fne. (testvalue-spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue+spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue+spacing(testvalue)) .fne. testvalue)')
  res = res .and. ((testvalue-spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue-spacing(testvalue)) .fne. testvalue)')

  res = res .and. (testvalue .flt. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .flt. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .fgt. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fgt. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .flt. testvalue)')
  res = res .and. ((testvalue+spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fgt. testvalue)')
  res = res .and..not. (testvalue .flt. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .flt. (testvalue-spacing(testvalue)))')
  res = res .and. (testvalue .fgt. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fgt. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .flt. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fgt. testvalue)')

  res = res .and. (testvalue .fle. testvalue)
  call checkTest(res, '(testvalue .fle. testvalue)')
  res = res .and. (testvalue .fge. testvalue)
  call checkTest(res, '(testvalue .fge. testvalue)')
  res = res .and. (testvalue .fle. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .fle. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .fge. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fge. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .fle. testvalue)')
  res = res .and. ((testvalue+spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fge. testvalue)')
  res = res .and..not. (testvalue .fle. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fle. (testvalue-spacing(testvalue)))')
  res = res .and. (testvalue .fge. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fge. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .fle. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fge. testvalue)')

  ! and with some rather small value
  write(*,*) 'testvalue = 9876543210_rk * 10_rk**(-100)'
  testvalue = 9876543210._rk * 10._rk**(-100)
  res = res .and. (testvalue .feq. testvalue)
  call checkTest(res, '(testvalue .feq. testvalue)')
  res = res .and..not. (testvalue .feq. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .feq. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .feq. (testvalue-spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .feq. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .feq. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .feq. testvalue)')

  res = res .and..not. (testvalue .fne. testvalue)
  call checkTest(res, '.not. (testvalue .fnq. testvalue)')
  res = res .and. (testvalue .fne. (testvalue+spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue+spacing(testvalue)))')
  res = res .and. (testvalue .fne. (testvalue-spacing(testvalue)))
  call checkTest(res, ' (testvalue .fne. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue+spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue+spacing(testvalue)) .fne. testvalue)')
  res = res .and. ((testvalue-spacing(testvalue)) .fne. testvalue)
  call checkTest(res, ' ((testvalue-spacing(testvalue)) .fne. testvalue)')

  res = res .and. (testvalue .flt. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .flt. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .fgt. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fgt. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .flt. testvalue)')
  res = res .and. ((testvalue+spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fgt. testvalue)')
  res = res .and..not. (testvalue .flt. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .flt. (testvalue-spacing(testvalue)))')
  res = res .and. (testvalue .fgt. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fgt. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .flt. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .flt. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .fgt. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fgt. testvalue)')

  res = res .and. (testvalue .fle. testvalue)
  call checkTest(res, '(testvalue .fle. testvalue)')
  res = res .and. (testvalue .fge. testvalue)
  call checkTest(res, '(testvalue .fge. testvalue)')
  res = res .and. (testvalue .fle. (testvalue+spacing(testvalue)))
  call checkTest(res, '(testvalue .fle. (testvalue+spacing(testvalue)))')
  res = res .and..not. (testvalue .fge. (testvalue+spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fge. (testvalue+spacing(testvalue)))')
  res = res .and..not. ((testvalue+spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '.not. ((testvalue+spacing(testvalue)) .fle. testvalue)')
  res = res .and. ((testvalue+spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '((testvalue+spacing(testvalue)) .fge. testvalue)')
  res = res .and..not. (testvalue .fle. (testvalue-spacing(testvalue)))
  call checkTest(res, '.not. (testvalue .fle. (testvalue-spacing(testvalue)))')
  res = res .and. (testvalue .fge. (testvalue-spacing(testvalue)))
  call checkTest(res, '(testvalue .fge. (testvalue-spacing(testvalue)))')
  res = res .and. ((testvalue-spacing(testvalue)) .fle. testvalue)
  call checkTest(res, '((testvalue-spacing(testvalue)) .fle. testvalue)')
  res = res .and..not. ((testvalue-spacing(testvalue)) .fge. testvalue)
  call checkTest(res, '.not. ((testvalue-spacing(testvalue)) .fge. testvalue)')

  if ( res ) write(*,*) 'PASSED'

contains

  subroutine checkTest(res, msg)
    logical, intent(in) :: res
    character(len=*), intent(in) :: msg

    if ( .not. res) then
      write(*,*) 'Test failed at ' // msg
      stop
    end if
  end subroutine

end program tem_float_test