test_calculator Subroutine

subroutine test_calculator()

call unit_test(‘calculator’, 0.eq.0, ‘checking’,100)

Arguments

None

Variables

Type Visibility Attributes Name Initial
integer, public, parameter :: dp = kind(0.0d0)
character(len=iclen_calc), public :: event
integer, public :: ierr
character(len=iclen_calc), public :: line
character(len=iclen_calc), public :: outlin
real(kind=dp), public :: rvalue

Source Code

subroutine test_calculator()
! iclen_calc : max length of expression or variable value as a string
integer, parameter         :: dp = kind(0.0d0)
character(len=iclen_calc) :: line
character(len=iclen_calc) :: outlin
character(len=iclen_calc) :: event
real(kind=dp)             :: rvalue
integer                   :: ierr

   call unit_test_start('calculator',msg='')

   ierr = 0
   call calculator('ownmode(1)', outlin, event, rvalue, ierr)

   ! activate user-defined function interface
   !!call unit_test('calculator', 0.eq.0, 'checking',100)

   line='1.3/sind(90)+1-20*2/3'
   call calculator(line, outlin, event, rvalue, ierr)
   select case (ierr)
      ! several different meanings to the error flag returned by calculator
   case (0)
      ! a numeric value was returned without error
      write (*, '(a,a,a)') trim(outlin), ' = ', trim(line)
   case (2)
      ! a string value was returned without error
      write (*, '(a)') trim(event(:int(rvalue)))
   case (1)
      ! a request for a message has been returned (from DUMP or FUNC)
      write (*, '(a,a)') 'message===>', trim(event(:len_trim(event)))
   case (-1)
      ! an error has occurred
      write (*, '(a,a)') 'error===>', trim(event(:len_trim(event)))
   case default
      ! this should not occur
      WRITE (6, '(A,i10)') '*CALCULATOR* UNEXPECTED IERR VALUE ', IERR
   end select

   call unit_test_end('calculator',msg='')
end subroutine test_calculator