anchor.diff:          CALL SETPAIR(RAW)
           CYCLE
         END IF
  -      CALL EVALUATE(RAW)
  +      CALL FMTDP(EVALUATE(RAW),SVAL,8)
  +      WRITE(6,9101) SVAL
    1001 CONTINUE
    8999 GOTO 9999
    9001 FORMAT(A64)
  + 9101 FORMAT('0***      RESULT: ',A8)
    9999 STOP
         END PROGRAM EVAL
   !------------------------------------------------------------------------------+
  -! CHCASE: CHange CASE of string to upper or lower.
  +! LCASE: Lower CASE.
   !------------------------------------------------------------------------------+
   ! STR - I/O - Character data to be converted to upper/lower case.
  -! TOUPR - I - .TRUE. if data is to be converted to upper case.
  -!------------------------------------------------------------------------------+
  -! Converts character data to upper or lower case.
  -!
  +!------------------------------------------------------------------------------+
  +! Converts character data to lower case.  Wraps CHGCASE
   ! The difference between the character values of lower and upper
   ! case.  In ASCII, A < a, in EBCDIC, A > a.  So, if this case is
   ! ASCII, DIFF will be a negative number, and converting from lower
   ! to upper will subtract the magnitude of the offset.
   !------------------------------------------------------------------------------+
  -      SUBROUTINE CHCASE(STR,TOUPR)
  +      SUBROUTINE LCASE(STR)
         IMPLICIT NONE
         CHARACTER*(*) STR
         CHARACTER C
  -      LOGICAL TOUPR
         INTEGER I,DIFF
         DIFF = ICHAR('A') - ICHAR('a')
         DO 1001 I = 1, LEN_TRIM(STR)
         C = STR(I:I)
  -      IF (TOUPR) THEN
  -        IF(C.ge.'a'.and.C.le.'z') STR(I:I) = CHAR(ICHAR(C)+DIFF)
  -      ELSE
  -        IF(C.ge.'A'.and.C.le.'Z') STR(I:I) = CHAR(ICHAR(C)-DIFF)
  -      ENDIF
  +      IF(C.ge.'A'.and.C.le.'Z') STR(I:I) = CHAR(ICHAR(C)-DIFF)
    1001 CONTINUE
  -      END SUBROUTINE CHCASE
  -!------------------------------------------------------------------------------+
  -! LCASE: Lower CASE.
  +      END SUBROUTINE LCASE
  +!------------------------------------------------------------------------------+
  +! UCASE: Upper CASE.
   !------------------------------------------------------------------------------+
   ! STR - I/O - Character data to be converted to upper/lower case.
   !------------------------------------------------------------------------------+
  -! Converts character data to lower case.  Wraps CHGCASE
  -!------------------------------------------------------------------------------+
  -      SUBROUTINE LCASE(STR)
  +! Converts character data to upper case.  Wraps CHGCASE
  +!------------------------------------------------------------------------------+
  +      SUBROUTINE UCASE(STR)
         IMPLICIT NONE
         CHARACTER*(*) STR
  -      CALL CHCASE(STR, .FALSE.)
  -      END SUBROUTINE LCASE
  -!------------------------------------------------------------------------------+
  -! UCASE: Upper CASE.
  -!------------------------------------------------------------------------------+
  -! STR - I/O - Character data to be converted to upper/lower case.
  -!------------------------------------------------------------------------------+
  -! Converts character data to upper case.  Wraps CHGCASE
  -!------------------------------------------------------------------------------+
  -      SUBROUTINE UCASE(STR)
  -      IMPLICIT NONE
  -      CHARACTER*(*) STR
  -      CALL CHCASE(STR, .TRUE.)
  +      CHARACTER C
  +      INTEGER I,DIFF
  +      DIFF = ICHAR('A') - ICHAR('a')
  +      DO 1001 I = 1, LEN_TRIM(STR)
  +      C = STR(I:I)
  +      IF(C.ge.'a'.and.C.le.'z') STR(I:I) = CHAR(ICHAR(C)+DIFF)
  + 1001 CONTINUE
         END SUBROUTINE UCASE
   !------------------------------------------------------------------------------+
  -! FMTDP: Format a DOUBLE PRECISION value to fit in buffer with max
  -! precision.
  -!------------------------------------------------------------------------------+
  -!  VAL * I * DOUBLE PRECISION value to format
  -!   WD * I * Desired field width
  -! BUFF * O * Buffer in which to write formatted value
  -!------------------------------------------------------------------------------+
  -! Error will result in writing '*' characters to the buffer.
  -! The format for real numbers is:
  -!                           Fw.d
  -!                           Ew.dEe
  -!                           Gw.d
  -! W is the total width, D is the number of digits to the right of
  -! the floating point.  This subroutine starts with the total width,
  -! and figures out how much width is allowaded for D.
  -!------------------------------------------------------------------------------+
  -! W    * 'w' of Gw.d format descriptor
  -! D    * 'd' of Gw.d format descriptor
  -! E    * 'e' of Ew.dEe format descriptor
  -! IOS  * IOSTAT for read/write operations
  -! FIOS * IOSTAT for reading FVAL from TBUF
  -! EIOS * IOSTAT for reading EVAL from TBUF
  -! FSTR * Fw.d format string
  -! ESTR * Ew.dEe format string
  -! TBUF * Temporary buffer for writing formated real value
  -! FVAL * Value read from buffer based of Fw.d format string
  -! EVAL * Value read from buffer based of Ew.d format string
  -!------------------------------------------------------------------------------+
         SUBROUTINE FMTDP(VAL, BUFF, WD)
  -      IMPLICIT NONE
  -      DOUBLE PRECISION VAL
  -      CHARACTER*(*) BUFF
  -      INTEGER WD
  -!
  -      INTEGER W, D, E, POW10
  -      INTEGER IOS, FIOS, EIOS
  -      CHARACTER*16 FSTR, ESTR
  -      CHARACTER*32 TBUF
  -      DOUBLE PRECISION FVAL, EVAL
  -!
  +!     Format a DOUBLE PRECISION value to fit in buffer with max precision.
  +!     Error will result in writing '*' characters to the buffer.
  +!     The format for real numbers is:
  +!                               Fw.d
  +!                               Ew.dEe
  +!                               Gw.d
  +!     W is the total width, D is the number of digits to the right of
  +!     the floating point.  This subroutine starts with the total width,
  +!     and figures out how much width is allowaded for D.
  +      IMPLICIT NONE
  +!     -------------------------------------------------------------------------+
  +      REAL(KIND=8),    INTENT(IN)  :: VAL  ! Value to format
  +      CHARACTER(LEN=*),INTENT(OUT) :: BUFF ! Buffer in which to write value
  +      INTEGER(KIND=4), INTENT(IN)  :: WD   ! Desired field width
  +!     -------------------------------------------------------------------------+
  +      INTEGER(KIND=4)   :: W      ! 'w' of Gw.d format descriptor
  +      INTEGER(KIND=4)   :: D      ! 'd' of Gw.d format descriptor
  +      INTEGER(KIND=4)   :: E      ! 'e' of Ew.dEe format descriptor
  +      INTEGER(KIND=4)   :: POW10  ! Reference to POW10 function
  +      INTEGER(KIND=4)   :: IOS    ! IOSTAT for read/write operations
  +      INTEGER(KIND=4)   :: FIOS   ! IOSTAT for reading FVAL from TBUF
  +      INTEGER(KIND=4)   :: EIOS   ! IOSTAT for reading EVAL from TBUF
  +      CHARACTER(LEN=16) :: FSTR   ! Fw.d format string
  +      CHARACTER(LEN=16) :: ESTR   ! Ew.dEe format string
  +      CHARACTER(LEN=32) :: TBUF   ! Temp buffer for writing real value
  +      REAL(KIND=4)      :: FVAL   ! Value read from buffer with Fw.d format
  +      REAL(KIND=4)      :: EVAL   ! Value read from buffer with Ew.d format
  +!     -------------------------------------------------------------------------+
         FVAL = 0D0
         EVAL = 0D0
         W = MIN(LEN(BUFF), WD)
  
positive.code: !         because the parenthesis states are 500 while operator states
  !         are 400.
            IF (S%TOKENS(S%COUNT)%STATE.LE.INFIX%TOKENS(I)%STATE) THEN
              CALL POP_TOKEN(T,S)                    ! POP OP FROM STACK
              CALL PUSH_TOKEN(T,Q)                   !     ONTO QUEUE
              CALL PUSH_TOKEN(INFIX%TOKENS(I),S)    ! PUSH NEXT OP TO STACK
            ELSE
              CALL PUSH_TOKEN(INFIX%TOKENS(I),S)    ! PUSH OP TO STACK
  
negative.code:  9001 FORMAT('0*** ERROR TOKEN: -->',A,'<--')
        END SUBROUTINE INFIX2POSTFIX
  !------------------------------------------------------------------------------+
        FUNCTION EVALUATE(STR) RESULT (VAL)
        IMPLICIT NONE
        CHARACTER STR*(*)
        TYPE(TYP_TOKLST) :: LST
        REAL(KIND=8) :: VAL
        CALL SCAN(STR,LST)
        CALL PARSE(STR,LST,VAL)
        END FUNCTION EVALUATE
  !------------------------------------------------------------------------------+
        END MODULE MOD_EVALUATE
  !------------------------------------------------------------------------------+
  