C
C FUNCTION 'FLPVAL'
C =================
C
C CONVERT A CHARACTER STRING TO A FLOATING POINT NUMBER
C J. W. CAMPBELL
C
      FUNCTION FLPVAL(CHSTR,ERR)
C
C PARAMETERS
C
C    CHSTR (I)   CHARACTER STRING CONTAINING THE FLOATING POINT
C                NUMBER (LEADING SPACES IGNORED; TRAILING SPACE DELIMITS)
C      ERR (O)   FLAG =.FALSE. CONVERSION OK, =.FALSE. SYNTAX ERROR
C
C FLPVAL RETURNS THE CONVERTED VALUE (0.0 IF SYNTAX ERROR)
C
C SPECIFICATION STATEMENTS AND INITIALISATIONS
C --------------------------------------------
C
      CHARACTER*(*) CHSTR
      CHARACTER*15 DIG
      LOGICAL ERR, END, START
      DOUBLE PRECISION S, X, FP
      DATA DIG/'eE0123456789.+-'/
C
      FLPVAL = 0.0
      END = .FALSE.
      ERR = .FALSE.
      IEXP = 0
      M1 = 3
      M2 = 15
      I = 0
      IMAX = LEN(CHSTR)
C
C INTERPRET NUMBER
C ----------------
C
 20   S = 1.0
      ID = 0
      IFDEC = 0
      X = 0.0
      START = .FALSE.
 30   I = I + 1
      IF (I.GT.IMAX) THEN
         END = .TRUE.
         IF (IEXP.NE.1) GO TO 40
         GO TO 50
      END IF
      IF (CHSTR(I:I).EQ.' ') THEN
         IF (.NOT.(START)) GO TO 30
         END = .TRUE.
         IF (IEXP.NE.1) GO TO 40
         GO TO 50
      END IF
      START = .TRUE.
      J = INDEX(DIG(M1:M2),CHSTR(I:I))
      IF (J.EQ.0) GO TO 60
      J = J + M1 - 1
      M1 = 1 + 2*IEXP
C DIGIT
      IF (J.GE.3 .AND. J.LE.12) THEN
         ID = ID + IFDEC
         X = 10.0*X + J - 3
         IF (M2.GT.13) M2 = 13
         GO TO 30
C DECIMAL POINT
      ELSE IF (J.EQ.13) THEN
         IF (IEXP.EQ.1) GO TO 60
         IFDEC = 1
         M2 = 12
         GO TO 30
C SIGN
      ELSE IF (J.GE.14) THEN
         IF (J.EQ.15) S = -1.0
         M2 = 13
         GO TO 30
C EXPONENT
      ELSE
         IEXP = 1
         M1 = 3
         M2 = 15
      END IF
C EVALUATE NUMBER
 40   FP = S*X/(10.0**ID)
      IF (END) THEN
         FLPVAL = FP
         RETURN
      END IF
      GO TO 20
C EVALUATE AND APPLY EXPONENT
 50   IEX = NINT(S*X)
      FP = FP*10.0**IEX
      FLPVAL = FP
      RETURN
C
C ERROR CONDITION
C
 60   ERR = .TRUE.
      FLPVAL = 0.0
      END
