Evaluate_r1fp64 Function

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

Arguments

TypeIntentOptionalAttributesName
class(EquationParser) :: parser
real(kind=real64) :: x(:,:)

Return Value real(kind=real64)(lbound(x,1):ubound(x,1))


Contents

Source Code


Source Code

  function Evaluate_r1fp64(parser,x) result(f)
    class(EquationParser) :: parser
    real(real64) :: x(:,:)
    real(real64) :: f(lbound(x,1):ubound(x,1))
    ! Local
    integer :: i,k
    type(Token) :: t
    type(r1fp64Stack) :: stack
    real(real64) :: vnumber
    real(real64),allocatable :: v(:)
    real(real64),allocatable :: a(:)
    real(real64),allocatable :: b(:)
    real(real64),allocatable :: c(:)

    allocate(v(lbound(x,1):ubound(x,1)), &
             a(lbound(x,1):ubound(x,1)), &
             b(lbound(x,1):ubound(x,1)), &
             c(lbound(x,1):ubound(x,1)))

    call stack%Construct(Stack_Length,v)

    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,*) vnumber
          v = vnumber
        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
    deallocate(v,a,b,c)

  endfunction Evaluate_r1fp64