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
  logical :: res = .true.

  write(*,*) 'testvalue = 0._rk'
  testvalue = 0._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 != 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 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
