B.2.8 Real Class Unit Test Program

This lightly commented program performs a unit test on the Real Class.

module Unit_Test_Module
  use Caesar_Real_Class
  implicit none

contains

  subroutine testreal (R)
    type(real) :: R
    type(logical) :: vs
    write (6,100) 'R = ', R
    vs = Valid_State(R)
    write (6,101) 'Valid_State(R)         ==> ', vs
    100 format (/, a, 1pe15.6)
    101 format (2x, a, l1)
    return
  end subroutine testreal
  
  subroutine testreal3 (R3)
    type(real,3) :: R3
    type(logical) :: vs
    write (6,100) 'R3(1,1,1) = ', R3(1,1,1)
    vs = Valid_State(R3)
    write (6,101) 'Valid_State(R3)        ==> ', vs
    100 format (/, a, 1pe15.6)
    101 format (2x, a, l1)
    return
  end subroutine testreal3
  
end module Unit_Test_Module

program Unit_Test
  use Unit_Test_Module
  use Caesar_Real_Class
  implicit none

  type(real) :: R, R2
  type(real,3) :: R3
  type(real) :: one, zero

  ! Initializations.

  call Initialize (R)
  call Initialize (R2)
  call Initialize (R3, 3, 4, 5)

  ! Parameters are not used here 
  ! to fool smart compilers.

  one = 1.d0
  zero = one - one

  ! Real tests.

  ifdef([DIVISION_BY_ZERO],[
    R = one/zero
    call testreal (R)
    R = -one/zero
    call testreal (R)
    R = zero/zero
    call testreal (R)
  ])
  R = zero
  call testreal (R)
  R = one
  call testreal (R)
  R = HUGE(one)
  call testreal (R)
  R = -HUGE(one)
  call testreal (R)

  ! Real multi-dimensional tests.

  R3 = one
  ifdef([DIVISION_BY_ZERO],[
    R3(1,1,1) = one/zero
    call testreal3 (R3)
    R3(1,1,1) = -one/zero
    call testreal3 (R3)
    R3(1,1,1) = zero/zero
    call testreal3 (R3)
  ])
  R3(1,1,1) = zero
  call testreal3 (R3)
  R3(1,1,1) = one
  call testreal3 (R3)
  R3(1,1,1) = HUGE(one)
  call testreal3 (R3)
  R3(1,1,1) = -HUGE(one)
  call testreal3 (R3)

  ! Real scalar function tests.

  write (6,*) 
  write (6,*) 'Real scalar function tests:'
  R = 1.23456789d0
  write (6,*) 'MaxVal(R) = ', MaxVal(R)
  write (6,*) 'MinVal(R) = ', MinVal(R)
  write (6,*) 'SUM(R)    = ', SUM(R)
  R2 = (((R + 1.d0) * 47.d0) - 47.d0) / 47.d0
  if (.not. VeryClose(R, R2)) then
    write (6,*) 'VeryClose Error: '
    write (6,*) '  R  = ', R
    write (6,*) '  R2 = ', R2
  end if

  ! Finalizations.

  call Finalize (R)
  call Finalize (R2)
  call Finalize (R3)

end