Evaluate_sfp64 Function

private function Evaluate_sfp64(parser, x) result(f)

Arguments

TypeIntentOptionalAttributesName
class(EquationParser) :: parser
real(kind=real64) :: x(1:parser%nIndepVars)

Return Value real(kind=real64)


Contents

Source Code


Source Code

  function Evaluate_sfp64(parser,x) result(f)
    class(EquationParser) :: parser
    real(real64) :: x(1:parser%nIndepVars)
    real(real64) :: f
    ! Local
    integer :: i,k
    type(Token) :: t
    type(sfp64Stack) :: stack
    real(real64) :: v,a,b,c

    call stack%Construct(Stack_Length)

    do k = 1,parser%postfix%top_index

      t = parser%postfix%tokens(k)%Copy()

      select case(t%tokenType)

      case(Number_Token)

        if(t%tokenString == 'pi' .or. t%tokenString == 'PI') then
          v = pi_real64
        else
          read(t%tokenString,*) v
        endif

        call stack%Push(v)

      case(Variable_Token)

        do i = 1,parser%nIndepVars
          if(trim(t%tokenString) == parser%indepVars(i)%value) then
            call stack%Push(x(i))
            exit
          endif
        enddo

      case(Operator_Token)

        call stack%Pop(a)
        call stack%Pop(b)

        select case(trim(t%tokenString))

        case('+')

          c = a+b

        case('-')

          c = b-a

        case('*')

          c = a*b

        case('/')

          c = b/a

        case('^')

          c = b**a
        case default

        endselect

        call stack%Push(c)

      case(Function_Token)

        call stack%Pop(a)

        b = Functions(t%tokenIndex)%invoke(a)

        call stack%Push(b)

      case(Monadic_Token)

        if(trim(t%tokenString) == '-') then
          call stack%Pop(a)
          a = -a
          call stack%Push(a)
        endif

      case default

      endselect

    enddo

    call stack%Pop(a)
    f = a
  endfunction Evaluate_sfp64