      SUBROUTINE CHARNUM(INSTRING,OUTNUM,IER)
C
C 30 SEPT 1989   J. T. ARMSTRONG    NDP FORTRAN
C
C CONVERT A CHARACTER STRING TO A REAL NUMBER
C ERROR CONDITIONS: 
C     IER = 0       NO ERROR
C     IER = 1       PROBLEM INTERPRETING INTEGER PART
C     IER = 2       PROBLEM INTERPRETING FRACTIONAL PART
C     IER = 3       PROBLEM INTERPRETING EXPONENT
C
      REAL*8        OUTNUM, INTPART, FRACPART, EXPON
      INTEGER*2     I, J, K
      INTEGER*4     IER, IEXP
      CHARACTER*(*) INSTRING
      CHARACTER*20  NEWSTRING

C---------------------------------------------------------------
C SET ERROR INDICATION TO ZERO; CLEAR NEWSTRING

      IER   = 0
      DO I = 1, 20
          NEWSTRING(I:I) = ' '
      END DO
C---------------------------------------------------------------
C STRIP OFF LEADING BLANKS FROM INSTRING

      I = 1
      J = 1
      DO WHILE (INSTRING(I:I).EQ.' '.OR.INSTRING(I:I).EQ.'-')
          IF (INSTRING(I:I).EQ.'-') THEN
              NEWSTRING(1:1) = '-'
              J = 2
          END IF
          I = I + 1
      END DO  ! I now points at first non-blank, non-minus char
C---------------------------------------------------------------
C READ INSTRING INTO NEWSTRING FOR INTEGER PART

      DO WHILE (INSTRING(I:I).NE.' '.AND.INSTRING(I:I).NE.'.'
     1          .AND.I.LE.LEN(INSTRING))

          IF ((INSTRING(I:I).GT.'9'.OR.INSTRING(I:I).LT.'0').AND. 
     1        (INSTRING(I:I).NE.'.'.AND.INSTRING(I:I).NE.'E'
     2         .AND.INSTRING(I:I).NE.'e'.AND.INSTRING(I:I).NE.' ')) 
     3               THEN 
              IER = 1
              GO TO 100
          ELSE
          NEWSTRING(J:J) = INSTRING(I:I)
              I = I + 1
              J = J + 1
          END IF
      END DO
      J = J - 1
      CALL INTERPR(NEWSTRING,J,INTPART)
      OUTNUM = INTPART

C FINISHED IF NEXT CHARACTER IS NOT '.', 'E', OR 'D'
      IF (INSTRING(I:I).NE.'.'.AND.INSTRING(I:I).NE.'E'
     1    .AND.INSTRING(I:I).NE.'e') GO TO 100           ! D, d TOO?

C CLEAR NEWSTRING
      DO K = 1, 20
          NEWSTRING(K:K) = ' '
      END DO
      J = 1

C---------------------------------------------------------------
C Read INSTRING into NEWSTRING for fractional part

      IF (INSTRING(I:I).EQ.'.') THEN
          I = I + 1  ! I now points at character after decimal point
          DO WHILE (INSTRING(I:I).NE.' '.AND.INSTRING(I:I).NE.'E'
     1              .AND.INSTRING(I:I).NE.'e'.AND.I.LE.LEN(INSTRING))

              IF ((INSTRING(I:I).GT.'9'.OR.INSTRING(I:I).LT.'0').AND.
     1            (INSTRING(I:I).NE.'E'.AND.INSTRING(I:I).NE.'e')
     2             .AND.INSTRING(I:I).NE.' ') THEN 

                  IER = 2
                  GO TO 100
              ELSE
              NEWSTRING(J:J) = INSTRING(I:I)
                  I = I + 1
                  J = J + 1
              END IF
          END DO
          J = J - 1
          CALL INTERPR(NEWSTRING,J,FRACPART)
          OUTNUM = SIGN((ABS(INTPART) + FRACPART / 10**J),INTPART)
      END IF

C CLEAR NEWSTRING
      DO K = 1, 20
          NEWSTRING(K:K) = ' '
      END DO
      J = 1

C---------------------------------------------------------------
C READ INSTRING INTO NEWSTRING FOR EXPONENT

      IF (INSTRING(I:I).EQ.'E'.OR.INSTRING(I:I).EQ.'e') THEN
          J = 1
          I = I + 1
          DO WHILE (INSTRING(I:I).NE.' '.AND.I.LE.LEN(INSTRING))

              IF ((INSTRING(I:I).GT.'9'.OR.INSTRING(I:I).LT.'0').AND. 
     1            (INSTRING(I:I).NE.' ').AND.INSTRING(I:I).NE.'-') THEN 

                  IER = 3
                  GO TO 100
              ELSE IF (INSTRING(I:I).EQ.'-') THEN
                      NEWSTRING(1:1) = '-'
                      J = 2
                      I = I + 1
              ELSE
                  NEWSTRING(J:J) = INSTRING(I:I)
                  I = I + 1
                  J = J + 1
              END IF
          END DO
          J = J - 1
          CALL INTERPR(NEWSTRING,J,EXPON)
          IEXP   = EXPON
          OUTNUM = OUTNUM * 10.**IEXP
      END IF

C---------------------------------------------------------------
C RETURN TO MAIN PROGRAM

  100 CONTINUE

      RETURN
      END

