C     RENBR(FIXFORT/CONVERT COLUMN 1 IN FORTRAN LISTING FILES)
C
C     BY DONALD E. BARTH
C
C     THIS PROGRAM WILL CONVERT THE FOLLOWING CHARACTERS
C     IN COLUMN 1 OF FORTRAN LISTING FILES:
C
C     1 TO NEW PAGE
C     0 TO DOUBLE SPACING
C     + TO OVERPRINT PREVIOUS LINE
C     * OR SPACE TO SINGLE SPACING
C
C     THE ASTERISK IS USED ON DEC COMPUTERS TO CONTINUE PRINTING
C     ACROSS THE FOLDS OF FAN FOLD PAPER WITHOUT SKIPPING LINES.
C     ON THE NORMAL PAGE, IT ACTS LIKE A SPACE CARRIAGE CONTROL
C     CHARACTER. IN THIS PROGRAM THE ASTERISK IS TREATED LIKE A
C     SPACE.
C
      CHARACTER*1 CHAR,LTRLF,LTRFF,LTRCR,LTRNOW
      CHARACTER*80 FILINP,FILOUT
      DATA ITTY,JTTY,IDISK,JDISK/0,0,1,2/
C
C     IDENTIFY THIS PROGRAM
      WRITE(JTTY,1)
    1 FORMAT(' FIXFORT'/
     1' Converts characters in column 1 of Fortran files',
     2' to form feeds and line feeds')
C
C     OPEN NEXT INPUT FILE
    2 WRITE(JTTY,3)
    3 FORMAT(' Input file? ',\)
      READ(ITTY,4)FILINP
    4 FORMAT(1A80)
      IF(FILINP.EQ.' ')GO TO 6
      OPEN(UNIT=IDISK,FILE=FILINP,STATUS='OLD',IOSTAT=ICHECK,
     1 FORM='BINARY')
      IF(ICHECK.EQ.0)GO TO 8
      WRITE(JTTY,5)
    5 FORMAT(' Cannot open input file')
      GO TO 2
    6 WRITE(JTTY,7)
    7 FORMAT(' Name of input file must be specified')
      GO TO 2
    8 CONTINUE
C
C     OPEN OUTPUT FILE
    9 WRITE(JTTY,10)
   10 FORMAT(' Output file? ',\)
      READ(ITTY,11)FILOUT
   11 FORMAT(1A80)
      IF(FILOUT.EQ.' ')GO TO 15
      OPEN(UNIT=JDISK,FILE=FILOUT,STATUS='OLD',IOSTAT=ICHECK)
      IF(ICHECK.NE.0)GO TO 17
      CLOSE(UNIT=JDISK)
   12 WRITE(JTTY,13)
   13 FORMAT(' File already exists. Replace it? ',\)
      READ(ITTY,14)LTRNOW
   14 FORMAT(1A1)
      IF(LTRNOW.EQ.'Y')GO TO 17
      IF(LTRNOW.EQ.'y')GO TO 17
      IF(LTRNOW.EQ.'N')GO TO 9
      IF(LTRNOW.EQ.'n')GO TO 9
      GO TO 12
   15 WRITE(JTTY,16)
   16 FORMAT(' Name of output file must be specified')
      GO TO 9
   17 OPEN(UNIT=JDISK,FILE=FILOUT,STATUS='NEW',IOSTAT=ICHECK,
     1 FORM='BINARY')
      IF(ICHECK.EQ.0)GO TO 19
      WRITE(JTTY,18)
   18 FORMAT(' Cannot open output file')
      GO TO 9
   19 CONTINUE
C
C     INITIALIZE
C
C     IONLIN = LENGTH OF LINE NOW BEING OUTPUT
C     ISTACK = 0, NO LF NEEDS TO BE OUTPUT, =1 OUTPUT ONE LF
C     KNTINP = NUMBER OF CHARACTERS READ FROM INPUT FILE
C     KNTLIN = NUMBER OF NON-EMPTY OUTPUT LINES
C     KNTOUT = NUMBER OF CHARACTERS WRITTEN TO OUTPUT FILE
C     MSTLIN = LENGTH OF LONGEST OUTPUT LINE
C     NEWLIN = 0 IF OUTPUTTING A LINE, = 1 IF READY TO START NEW LINE
C
      IONLIN=0
      ISTACK=0
      KNTINP=0
      KNTLIN=0
      KNTOUT=0
      MSTLIN=0
      NEWLIN=-1
C
C     END OF LINE CHARACTERS
C
C     LTRCR,LTRLF,LTRFF = THE CHARACTERS CR, LF, FF
C     INPCR,INPLF,INPFF = NUMBERS OF INPUT CR, LF, FF
C     KNTCR,KNTLF,KNTFF = NUMBERS OF OUTPUT CR, LF, FF
C
      LTRLF=CHAR(10)
      LTRFF=CHAR(12)
      LTRCR=CHAR(13)
      INPCR=0
      INPLF=0
      INPFF=0
      KNTCR=0
      KNTLF=0
      KNTFF=0
C
C     COPY THE FILE, CONVERTING START OF EACH NEW LINE AS FOUND
   20 READ(IDISK,END=31)LTRNOW
      KNTINP=KNTINP+1
      KODE=ICHAR(LTRNOW)
      IF(KODE.EQ.0)GO TO 20
C
C     LOOK FOR END OF LINE CHARS: LF=10, FF=12, CR=13
      IF(KODE.EQ.10)GO TO 25
      IF(KODE.EQ.12)GO TO 27
      IF(KODE.EQ.13)GO TO 29
      IF(NEWLIN.EQ.0)GO TO 24
      NEWLIN=0
C
C     START OF A NEW LINE
      IF(ISTACK.EQ.0)GO TO 21
      IF(LTRNOW.EQ.'+')ISTACK=0
      IF(LTRNOW.EQ.'1')ISTACK=0
      IF(ISTACK.EQ.0)GO TO 21
      ISTACK=0
      WRITE(JDISK)LTRLF
      KNTOUT=KNTOUT+1
      KNTLF=KNTLF+1
   21 CONTINUE
C
C     INITIAL ONE INDICATES FORM FEED
      IF(LTRNOW.NE.'1')GO TO 22
      WRITE(JDISK)LTRFF
      KNTOUT=KNTOUT+1
      KNTFF=KNTFF+1
   22 CONTINUE
C
C     INITIAL ZERO INDICATES DOUBLE LINE SPACING
      IF(LTRNOW.NE.'0')GO TO 23
      WRITE(JDISK)LTRLF
      KNTOUT=KNTOUT+1
      KNTLF=KNTLF+1
   23 CONTINUE
C
C     INITIALIZE TO START OF LINE
      KNTLIN=KNTLIN+1
      CALL RUNLIN(KNTLIN,ITTY,JTTY)
      IONLIN=0
      NEWLIN=0
C
C     DECIDE IF HAVE TO SHOW PRINTING CHARACTER
      IPRINT=1
      IF(LTRNOW.EQ.' ')IPRINT=0
      IF(LTRNOW.EQ.'*')IPRINT=0
      IF(LTRNOW.EQ.'1')IPRINT=0
      IF(LTRNOW.EQ.'0')IPRINT=0
      IF(LTRNOW.EQ.'+')IPRINT=0
      IF(IPRINT.EQ.0)GO TO 20
      GO TO 24
C
C     OUTPUT THE SINGLE NEW CHARACTER
   24 KNTOUT=KNTOUT+1
      IONLIN=IONLIN+1
      WRITE(JDISK)LTRNOW
      IF(MSTLIN.LT.IONLIN)MSTLIN=IONLIN
      GO TO 20
C
C     LINE FEED (10)
   25 INPLF=INPLF+1
      IF(ISTACK.EQ.0)GO TO 26
      WRITE(JDISK)LTRLF
      KNTOUT=KNTOUT+1
      KNTLF=KNTLF+1
      ISTACK=0
   26 CONTINUE
      ISTACK=1
      NEWLIN=1
      GO TO 20
C
C     FORM FEED (12)
   27 INPFF=INPFF+1
      IF(ISTACK.EQ.0)GO TO 28
      WRITE(JDISK)LTRLF
      KNTOUT=KNTOUT+1
      KNTLF=KNTLF+1
      ISTACK=0
   28 CONTINUE
      WRITE(JDISK)LTRFF
      KNTOUT=KNTOUT+1
      KNTFF=KNTFF+1
      NEWLIN=1
      GO TO 20
C
C     CARRIAGE RETURN (13)
   29 INPCR=INPCR+1
      IF(ISTACK.EQ.0)GO TO 30
      WRITE(JDISK)LTRLF
      KNTOUT=KNTOUT+1
      KNTLF=KNTLF+1
      ISTACK=0
   30 CONTINUE
      WRITE(JDISK)LTRCR
      KNTOUT=KNTOUT+1
      KNTCR=KNTCR+1
      NEWLIN=1
      GO TO 20
C
C     INSERT LINE FEED AT END OF FILE
   31 IF(ISTACK.EQ.0)GO TO 32
      WRITE(JDISK)LTRLF
      KNTOUT=KNTOUT+1
      KNTLF=KNTLF+1
      ISTACK=0
   32 CONTINUE
C
C     REPORT STATISTICS
      WRITE(JTTY,33)KNTINP
      WRITE(JTTY,34)KNTOUT
      WRITE(JTTY,35)MSTLIN
      WRITE(JTTY,36)KNTLIN
      WRITE(JTTY,37)INPLF,KNTLF
      WRITE(JTTY,38)INPFF,KNTFF
      WRITE(JTTY,39)INPCR,KNTCR
   33 FORMAT(' ',1I10,' bytes read')
   34 FORMAT(' ',1I10,' bytes written')
   35 FORMAT(' ',1I10,' length of longest output line')
   36 FORMAT(' ',1I10,' non-empty lines')
   37 FORMAT(' ',1I10,'/',1I10,' line feeds read/written')
   38 FORMAT(' ',1I10,'/',1I10,' form feeds read/written')
   39 FORMAT(' ',1I10,'/',1I10,' returns read/written')
C
C     ALL DONE
      END
      SUBROUTINE RUNLIN(LINE,ITTY,JTTY)
      IF(LINE.EQ.1)WRITE(JTTY,1)LINE
      IF(LINE.GT.        1.AND.LINE.LT.        10)WRITE(JTTY,2)LINE
      IF(LINE.GE.       10.AND.LINE.LT.       100)WRITE(JTTY,3)LINE
      IF(LINE.GE.      100.AND.LINE.LT.      1000)WRITE(JTTY,4)LINE
      IF(LINE.GE.     1000.AND.LINE.LT.     10000)WRITE(JTTY,5)LINE
      IF(LINE.GE.    10000.AND.LINE.LT.    100000)WRITE(JTTY,6)LINE
      IF(LINE.GE.   100000.AND.LINE.LT.   1000000)WRITE(JTTY,7)LINE
      IF(LINE.GE.  1000000.AND.LINE.LT.  10000000)WRITE(JTTY,8)LINE
      IF(LINE.GE. 10000000.AND.LINE.LT. 100000000)WRITE(JTTY,9)LINE
      IF(LINE.GE.100000000.AND.LINE.LT.1000000000)WRITE(JTTY,10)LINE
C                123456789             1234567890
    1 FORMAT(' ',1I1)
    2 FORMAT('+',1I1)
    3 FORMAT('+',1I2)
    4 FORMAT('+',1I3)
    5 FORMAT('+',1I4)
    6 FORMAT('+',1I5)
    7 FORMAT('+',1I6)
    8 FORMAT('+',1I7)
    9 FORMAT('+',1I8)
   10 FORMAT('+',1I9)
      RETURN
      END
