C-----------------------------------------------------------------------
C
C            Free format numeric input routine for NRCVAX
C
C  Routine to get 20 reals and 20 integers from free form input.
C  The routine works in two stages from a character input string.
C  First commas are removed from the string and substituted with blanks,
C  redundant blanks are removed and only numeric characters allowed.
C  The division / is retained and fractions are interpreted later.
C  Second, the cleaned up string is interpreted to give the numbers.
C
C  Normal input is from the terminal with IUNIT = ITR, but IUNIT can
C  also be the unit number for a file.
C
C  If IUNIT .GE. 1000 then it is assumed that the input string is
C  already in OCHAR and no read is performed.
C
C  If IUNIT .GE. 2000 no read is performed and IUNIT is returned as
C  a 0 if no error or 1 if an error is detected.
C
C  If the input unit is ITR (the terminal) and the first character is
C  a question mark (?) the routine exits to the system monitor.
C
C  The routine can also interpret fractions e.g 5/4 = 1.25 and E format
C
C-----------------------------------------------------------------------
      SUBROUTINE FREEFM (IUNIT)
      COMMON /IOUASS/ IOUNIT(12)
      CHARACTER*100 COUT(20)
      COMMON /IOUASC/ COUT 
      COMMON /INFREE/ IFREE(20),RFREE(20),ICFLAG
      COMMON /FREECH/ OCHAR
      CHARACTER OCHAR*100,NCHAR*100,LAST*1,THIS*1,COMMA*1,BLANK*1,
     $          NUMS*17,CZERO*1
      DATA COMMA/','/,BLANK/' '/,NUMS/' 0123456789.,+-/E'/,CZERO/'0'/
      IZERO = ICHAR(CZERO)
      ITR    = IOUNIT(5)
      ITP    = IOUNIT(6)
      IBYLEN = IOUNIT(12)
C-----------------------------------------------------------------------
C  If IUNIT .lt. 1000 it is the input unit number
C  If it is between 1000 and 2000 the string OCHAR has already been read
C  and it is merely to be interpreted.
C  If IUNIT .ge. 2000 an error flag may be returned in IUNIT.
C-----------------------------------------------------------------------
      IF (IUNIT .LT. 1000) THEN
        IREAD = IUNIT
      ELSE
        IERROR = 0
        GO TO 105
      ENDIF
C-----------------------------------------------------------------------
C  Read a character string.  Only 80 for IBM terminals !!!
C-----------------------------------------------------------------------
  100 IF (IUNIT .EQ. ITR) CALL GWRITE (ITP,'$')
      OCHAR = ' '
      IF (IREAD .EQ. ITR) THEN
         CALL GETLIN (OCHAR)
      ELSE 
         READ (IREAD,10000,END=250) OCHAR(1:80)
      ENDIF 
      IF (IREAD .EQ. ITR .AND. OCHAR(1:1) .EQ. '?') STOP
C-----------------------------------------------------------------------
C  Find the last non-blank character
C-----------------------------------------------------------------------
  105 ICFLAG = 1
        DO 110 I = 1,100
        J = 101 - I
        IF (OCHAR(J:J) .NE. BLANK) GO TO 120
  110   CONTINUE
      ICFLAG = 0
  120 IF (OCHAR(J:J) .NE. COMMA) THEN
        J = J + 1
        OCHAR(J:J) = COMMA
      ENDIF
      LEN = J
C-----------------------------------------------------------------------
C  Check for valid characters.  0 to 9 . , + - blank or E
C-----------------------------------------------------------------------
      DO 140 I = 1,LEN
        DO 130 J = 1,17
          IF (OCHAR(I:I) .EQ. NUMS(J:J)) GO TO 140
  130   CONTINUE
      IF (IUNIT .GE. 2000) THEN
        OCHAR(I:I) = BLANK
        GO TO 140
      ENDIF
C-----------------------------------------------------------------------
C  Get a corrected input string
C-----------------------------------------------------------------------
      WRITE (COUT,11000)
      GO TO 100
  140 CONTINUE
C-----------------------------------------------------------------------
C  Clean up the string
C-----------------------------------------------------------------------
      NCHAR = ' '
      LAST = COMMA
      NNEW = 1
      DO 150 NOLD = 1,LEN
      THIS = OCHAR(NOLD:NOLD)
      IF (THIS .EQ. '+') THEN
        IF (LAST .NE. COMMA .AND. LAST .NE. BLANK) THEN
          NCHAR(NNEW:NNEW) = BLANK
          NNEW = NNEW + 1
        ENDIF
        GO TO 150
      ENDIF
      IF (THIS .EQ. '-') THEN
        IF (LAST .NE. COMMA .AND. LAST .NE. BLANK) THEN
          NCHAR(NNEW:NNEW) = BLANK
          NNEW = NNEW + 1
        ENDIF
        NCHAR(NNEW:NNEW) = THIS
        NNEW = NNEW + 1
        GO TO 150
      ENDIF
C-----------------------------------------------------------------------
C  Treat the case not a comma or blank
C-----------------------------------------------------------------------
      IF (THIS .NE. BLANK .AND. THIS .NE. COMMA) THEN
        NCHAR(NNEW:NNEW) = THIS
        NNEW = NNEW + 1
      ENDIF
C-----------------------------------------------------------------------
C  Treat the case of this character is a comma
C-----------------------------------------------------------------------
      IF (THIS .EQ. COMMA) THEN
        IF (LAST .EQ. COMMA .OR. LAST .EQ. BLANK) THEN
          NCHAR(NNEW:NNEW) = '0'
          NNEW = NNEW + 1
          NCHAR(NNEW:NNEW) = BLANK
          NNEW = NNEW + 1
        ENDIF
        IF (LAST .NE. COMMA .AND. LAST .NE. BLANK) THEN
          NCHAR(NNEW:NNEW) = BLANK
          NNEW = NNEW + 1
        ENDIF
      ENDIF
C-----------------------------------------------------------------------
C  Treat the case of this character is a blank
C-----------------------------------------------------------------------
      IF (THIS .EQ. BLANK) THEN
        IF (LAST .NE. BLANK .AND. LAST .NE. COMMA) THEN
          NCHAR(NNEW:NNEW) = BLANK
          NNEW = NNEW + 1
        ENDIF
      ENDIF
      LAST = THIS
  150 CONTINUE
C-----------------------------------------------------------------------
C  Now extract the 20 pairs of values
C-----------------------------------------------------------------------
      DO 200 I = 1,20
        IFREE(I) = 0
  200   RFREE(I) = 0.0
      IPT = 0
      IFIELD = 0
      IDIV = 0
  210 ISIGN = 1
      NUM = 0
      DEC = 1.0
      IDEC = 0
      IC = 0
  220 IPT = IPT + 1
      IF (IPT .GT. NNEW) THEN
        IF (IUNIT .GE. 2000) IUNIT = IERROR
        RETURN
      ENDIF
      THIS = NCHAR(IPT:IPT)
      IF (THIS .EQ. ' ') GO TO 230
      IF (THIS .EQ. '/') THEN
        IDIV = 1
        GO TO 230
      ENDIF
      IF (THIS .EQ. 'E') THEN
        IDIV = 3
        GO TO 230
      ENDIF
      IF (THIS .EQ. '-') THEN
        IF (IC .NE. 0) THEN
          WRITE (COUT,12000)
          IF (IUNIT .GE. 2000) GO TO 240
          GO TO 100
        ENDIF
        ISIGN = -1
        GO TO 220
      ENDIF
      IF (THIS .EQ. '.') THEN
        IF (IDEC .EQ. 1) THEN
          WRITE (COUT,13000)
          IF (IUNIT .GE. 2000) GO TO 240
          GO TO 100
        ENDIF
        IDEC = 1
        GO TO 220
      ENDIF
      IC = ICHAR(THIS) - IZERO
      NUM = 10*NUM + IC
      IF (NUM .GT. 2147483647) THEN
        WRITE (COUT,14000)
        IF (IUNIT .GE. 2000) GO TO 240
        GO TO 100
      ENDIF
      IF (IDEC .NE. 0) DEC = 10.0*DEC
      GO TO 220
C-----------------------------------------------------------------------
C  Work out the number and put it away
C-----------------------------------------------------------------------
  230 NUM = ISIGN*NUM
      RNUM = NUM/DEC
      IF (IDIV .EQ. 1) THEN
        TOP = NUM
        IDIV = 2
        GO TO 210
      ENDIF
      IF (IDIV .EQ. 2) THEN
        BOT = NUM
        RNUM = TOP/BOT
        NUM = RNUM
        IDIV = 0
      ENDIF
      IF (IDIV .EQ. 3) THEN
        TOP = RNUM
        IDIV = 4
        GO TO 210
      ENDIF
      IF (IDIV .EQ. 4) THEN
        BOT = 10.0**NUM
        RNUM = TOP*BOT
        IDIV = 0
      ENDIF
      IFIELD = IFIELD + 1
      IFREE(IFIELD) = RNUM
      IF (IDEC .EQ. 0) IFREE(IFIELD) = NUM
      RFREE(IFIELD) = RNUM
      GO TO 210
C-----------------------------------------------------------------------
C  Set the error flag for REFIN calls
C-----------------------------------------------------------------------
  240 WRITE (COUT,10000) OCHAR(1:LEN)
      CALL GWRITE (ITP,' ')
      IERROR = 1
      IUNIT = IERROR
      RETURN
  250 CALL SETIOU (JUNK,JUNK,JUNK,ITR,ITP,IBYLEN)
      IF (IREAD .EQ. ITR) THEN
        OCHAR = ' '
        REWIND IREAD
        GO TO 105
      ELSE
        WRITE (COUT,15000) IREAD
        CALL GWRITE (ITP,' ')
        STOP
      ENDIF
10000 FORMAT (A)
11000 FORMAT (' TYPO -- Numeric characters only. Try again please.')
12000 FORMAT (' TYPO -- Minus sign incorrect. Try again please.')
13000 FORMAT (' TYPO -- Too many decimal points. Try again please.')
14000 FORMAT (' TYPO -- Too many digits in number. Try again please.')
15000 FORMAT (' Unexpected EOF on Unit',I3,'.  Job Aborted.'/'%')
      END
