SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc)
!----- -------- --------- --------- --------- --------- --------- --------- -------
! Check syntax of function string, returns 0 if syntax is ok
!----- -------- --------- --------- --------- --------- --------- --------- -------
IMPLICIT NONE
CHARACTER (LEN=*), INTENT(in) :: FuncStr ! Original function string
CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var ! Array with variable names
CHARACTER (LEN=*), OPTIONAL, INTENT(inout) :: ExtVar
LOGICAL, OPTIONAL :: needed(:)
INTEGER, OPTIONAL :: rc
INTEGER :: n
CHARACTER (LEN=1) :: c
REAL :: r
LOGICAL :: err
INTEGER :: ParCnt, & ! Parenthesis counter
j,ib,in,lFunc
LOGICAL :: isUndef
character(len=ESMF_MAXPATHLEN) :: func
integer, allocatable :: ipos(:)
!----- -------- --------- --------- --------- --------- --------- --------- -------
Func = FuncStr ! Local copy of function string
ALLOCATE (ipos(LEN_TRIM(FuncStr)))
CALL Replace ('**','^ ',Func) ! Exponent into 1-Char. format
CALL RemoveSpaces (Func,ipos)
j = 1
ParCnt = 0
lFunc = LEN_TRIM(Func)
if (present(needed)) needed = .false.
step: DO
IF (j > lFunc) CALL ParseErrMsg (j, FuncStr, ipos)
c = Func(j:j)
!-- -------- --------- --------- --------- --------- --------- --------- -------
! Check for valid operand (must appear)
!-- -------- --------- --------- --------- --------- --------- --------- -------
IF (c == '-' .OR. c == '+') THEN ! Check for leading - or +
j = j+1
IF (j > lFunc) THEN
_FAIL('Missing operand in '//trim(funcstr))
END IF
c = Func(j:j)
IF (ANY(c == Ops)) THEN
_FAIL('Multiple operators in '//trim(funcstr))
END IF
END IF
n = MathFunctionIndex (Func(j:))
IF (n > 0) THEN ! Check for math function
j = j+LEN_TRIM(Funcs(n))
IF (j > lFunc) THEN
_FAIL('Missing function argument in '//trim(funcStr))
END IF
c = Func(j:j)
IF (c /= '(') THEN
_FAIL('Missing opening parenthesis in '//trim(funcstr))
END IF
END IF
IF (c == '(') THEN ! Check for opening parenthesis
ParCnt = ParCnt+1
j = j+1
CYCLE step
END IF
IF (SCAN(c,'0123456789.') > 0) THEN ! Check for number
r = RealNum (Func(j:),ib,in,err)
IF (err) THEN
_FAIL('Invalid number format: '//Func(j+ib-1:j+in-2))
END IF
j = j+in-1
IF (j > lFunc) EXIT
c = Func(j:j)
ELSE ! Check for variable
isUndef = checkUndef(Func(j:),ib,in)
if (isUndef) then
j = j+in-1
IF (j> lFunc) EXIT
c = Func(j:j)
else
n = VariableIndex (Func(j:),Var,ib,in)
if (present(needed).and.(n>0)) needed(n)=.true.
IF (n == 0) THEN
IF (present(ExtVar)) then
ExtVar = trim(ExtVar)//Func(j+ib-1:j+in-2)//","
ELSE
_FAIL('Invalid element: '//Func(j+ib-1:j+in-2))
ENDIF
END IF
j = j+in-1
IF (j > lFunc) EXIT
c = Func(j:j)
end if
END IF
DO WHILE (c == ')') ! Check for closing parenthesis
ParCnt = ParCnt-1
IF (ParCnt < 0) THEN
_FAIL('Mismatched parenthesis in '//trim(funcStr))
END IF
IF (Func(j-1:j-1) == '(') THEN
_FAIL('Empty paraentheses '//trim(funcstr))
END IF
j = j+1
IF (j > lFunc) EXIT
c = Func(j:j)
END DO
!-- -------- --------- --------- --------- --------- --------- --------- -------
! Now, we have a legal operand: A legal operator or end of string must follow
!-- -------- --------- --------- --------- --------- --------- --------- -------
IF (j > lFunc) EXIT
IF (ANY(c == Ops)) THEN ! Check for multiple operators
IF (j+1 > lFunc) THEN
_FAIL('needs informative message')
END IF
IF (ANY(Func(j+1:j+1) == Ops)) THEN
_FAIL('Multiple operatos in '//trim(Funcstr))
END IF
ELSE ! Check for next operand
_FAIL('Missing operator in '//trim(funcstr))
END IF
!-- -------- --------- --------- --------- --------- --------- --------- -------
! Now, we have an operand and an operator: the next loop will check for another
! operand (must appear)
!-- -------- --------- --------- --------- --------- --------- --------- -------
j = j+1
END DO step
IF (ParCnt > 0) THEN
_FAIL('Missing ) in '//trim(funcstr))
END IF
DEALLOCATE(ipos)
_RETURN(ESMF_SUCCESS)
END SUBROUTINE CheckSyntax