CTITLEUSCDRR - DECODE A FLOATING POINT FIELD
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
C
CA    AUTHOR                 H. W. SWAN
CA    DESIGNER               H. W. SWAN
CA    SYSTEM                 IBM/CRAY
CA    LANGUAGE               VS FORTRAN VERSION 2.2
CA    WRITTEN                12-03-87
C     REVISED       05-23-91 JJC - CHANGED IMPLICIT TO (A-Z).
C     REVISED       12-17-91 JJC - MODIFIED TO MEET SPARC STANDARDS.
CA
CA   IN/OUT   ARGUMENT   TYPE   DESCRIPTION
CA
CA     IN      STRING    C*(*)   THE INPUT STRING TO BE DECODED
CA     IN        *       LABEL   A FORTRAN LABEL TO GAIN CONTROL
CA                               IF 'STRING' IS NOT A VALID FLOAT
CA     IN      FMAT      C*(*)   THE FORMAT STATMENT TO DECODE THE
CA                               FLOATING POINT FIELD
CA     OUT      VAL       R4     THE DECODED FLOATING POINT VARIABLE
CA
CA
CA
CA   PURPOSE:   TO SCAN A STRING TO MAKE SURE IT'S A VALID FLOATING
CA              POINT CONSTANT, AND THEN TO DECODE IT.
CA
CA   EXAMPLE:
CA
CA THE FOLLOWING TWO GROUPS OF STATEMENTS SHOULD BE EQUIVALENT:
CA
CA 1)       CHARACTER*6 STRING
CA          READ (STRING, 7000, ERR=100) VAL
CA     7000 FORMAT(F6.0)
CA
CA 2)       CHARACTER*6 STRING, FMAT
CA          FMAT = '(F6.0)'
CA          CALL USCDRR(STRING, *100, FMAT, VAL)
CA
CA UNFORTUNATELY, ALTERNATIVE (1) DOESN'T WORK, WHICH IS WHY 'USCDRR'
CA WAS WRITTEN.
CA
CA
      SUBROUTINE USCDRR(STRING,*,FMAT,VAL)
C
CJJ   IMPLICIT NONE
      IMPLICIT INTEGER (A-Z)
C
      INTEGER LENGTH, IBND1, IBND2, NDEC, NE, I, IC
      REAL VAL
      CHARACTER     C
      CHARACTER*(*) STRING, FMAT

C
C  CHECK TO MAKE SURE THERE ARE NO NON-NUMERIC CHARACTERS IN 'STRING'.
C
      LENGTH = LEN(STRING)
      IBND1  = ICHAR('0')
      IBND2  = ICHAR('9')
      NDEC   = 0
      NE     = 0
      DO 100 I=1,LENGTH
           C  = STRING(I:I)
           IF(C .EQ. ' ' .OR. C .EQ. '+' .OR. C .EQ. '-') GO TO 100
           IF(C .EQ. '.') THEN
                 NDEC = NDEC + 1
                 IF(NDEC.GT.1) RETURN 1
                 GO TO 100
                 ENDIF
           IF(C .EQ. 'E') THEN
                 NE = NE + 1
                 IF(NE.GT.1) RETURN 1
                 GO TO 100
                 ENDIF
           IC = ICHAR(C)
           IF(IC .LT. IBND1 .OR. IC .GT. IBND2) RETURN 1
 100       CONTINUE
C
C   NOW IT'S PROBABLY SAFE TO DO THE INTERNAL READ.
C
      READ (STRING,FMAT) VAL
      RETURN
      END