CheckSyntax Subroutine

public subroutine CheckSyntax(FuncStr, Var, needed, ExtVar, rc)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: FuncStr
character(len=*), intent(in), DIMENSION(:) :: Var
logical, optional :: needed(:)
character(len=*), intent(inout), optional :: ExtVar
integer, optional :: rc

Calls

proc~~checksyntax~~CallsGraph proc~checksyntax CheckSyntax interface~mapl_assert MAPL_Assert proc~checksyntax->interface~mapl_assert proc~lowcase LowCase proc~checksyntax->proc~lowcase proc~mapl_return MAPL_Return proc~checksyntax->proc~mapl_return proc~realnum RealNum proc~checksyntax->proc~realnum at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception

Called by

proc~~checksyntax~~CalledByGraph proc~checksyntax CheckSyntax proc~mapl_stateeval MAPL_StateEval proc~mapl_stateeval->proc~checksyntax none~evaluate_box_mask ExtDataMask%evaluate_box_mask none~evaluate_box_mask->proc~mapl_stateeval none~evaluate_region_mask ExtDataMask%evaluate_region_mask none~evaluate_region_mask->proc~mapl_stateeval none~evaluate_zone_mask ExtDataMask%evaluate_zone_mask none~evaluate_zone_mask->proc~mapl_stateeval proc~evaluate_derived_field DerivedExport%evaluate_derived_field proc~evaluate_derived_field->proc~mapl_stateeval none~evaluate_mask ExtDataMask%evaluate_mask proc~evaluate_derived_field->none~evaluate_mask none~evaluate_mask->none~evaluate_box_mask none~evaluate_mask->none~evaluate_region_mask none~evaluate_mask->none~evaluate_zone_mask

Source Code

  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