      PROGRAM DERIER
C     GLENN MILLER APRIL 81
C     OUR PRESENT MORTRAN PROCESSOR CONVERTS ALL CHARACTER
C     STRINGS TO HOLLERITH CONSTANTS. THIS WOULD BE FATAL TO
C     ANY FORTRAN-77 PROGRAMS. THIS PROGRAM IS A REAR-END
C     TO THE MORTRAN PROCESSOR AND RESTORES THE QUOTED STRINGS.
C     WE HAVE A MORTRAN MACRO THAT FLAGS ALL STRINGS
C     %'''#'''='&SOS''#''&EOS'
C     THIS PROGRAM CONVERTS &SOS AND &EOS BACK TO '
C     AND ALSO DOUBLES ANY ' IN THE ORGINAL FILE.
C       RECALL THE CARD FORMAT:
C       COLS 1-5 CONTAIN A LINE NUMBER OR BLANKS FOR THE FIRST CARD
C       AND MUST BE BLANK FOR CONTINUATION CARDS. IF COL6 CONTAINS
C       ANYTHING BESIDES A BLANK OR ZERO, THE CARD IS A CONTINUATION CARD.
C       THE STATEMENT IS IN COLS 7-72, A TOTAL OF 66 CHARACTERS.
C       THEREFORE YOU'LL SEE LOTS OF 72'S AND 66'S IN THIS PROGRAM
C
      INTEGER IN,OUT
        CHARACTER INFIL*7,OUTFIL*7,LINE*72
      PARAMETER(
     # IN=5,
     # OUT=6,
     # INFIL='FTN',
     # OUTFIL='FTNDER')
      CHARACTER*4 SOS
      PARAMETER(SOS='&SOS')
        CHARACTER*1 AMPERS
        PARAMETER(AMPERS='&')
C
      OPEN(IN,FILE=INFIL)
      OPEN(OUT,FILE=OUTFIL)
C       READ FIRST LINE
        READ(IN,'(A72)',END=120) LINE
C
C       SEARCH FOR AMPERS
C       (NOTE CANT SEARCH FOR &SOS SINCE IT MAY BE SPLIT ONTO 2 CARDS)
C

100     IF ( INDEX(LINE,AMPERS) .GT. 0) THEN
                CALL EXAMIN(LINE)
C               EXAMIN RETURNS WITH THE NEXT NON-CONTINUATION LINE
C               IN LINE, OR IT DOESNT RETURN IF IT FINDS EOF
        ELSE
                WRITE(OUT,'(A72)') LINE
                READ(IN,'(A72)',END=120) LINE
        ENDIF
        GOTO 100
C
120     CONTINUE
        END
        SUBROUTINE EXAMIN(LINE)
C     THIS PUTS THE FORTRAN STATEMENT INTO A BUFFER, READING
C     CONTINUATIONS CARDS IF THERE (DISCARDING 1ST 6 COLS OF
C     CONTINUATION CARD). IT THEN EXAMINES
C       EACH CHARACTER, REPLACES &SOS.....H AND &EOS
C       WITH A '   IT ALSO DOUBLES ANY ', SINCE ANY THAT
C       MAKE IT THIS FAR BETTER BE IN A STRING
C
        CHARACTER*(*) LINE
        CHARACTER*1 QUOTE
        CHARACTER*4 SOS,EOS
        PARAMETER(QUOTE='''',SOS='&SOS',EOS='&EOS')
        CHARACTER*1440 INBUF,OUTBUF
C       FORTRAN LAW: 1CARD+19 CONTINUATION *72 =1440 CHARS
        LOGICAL EOF
C
        CALL FILBUF(INBUF,LINE,NCHAR,EOF)
C       NCHAR IS HOW MANY CHARS READ INTO INBUF,
C       TRUE EOF MEANS END OF FILE WAS READ
C     FIRST 6 CHARS GO AS IS
      OUTBUF(1:6)=INBUF(1:6)
C
C     JIN POINTS TO NEXT CHAR IN INBUF TO BE EXAMINED
C     JOUT POINTS TO NEXT SLOT IN OUTBUF TO GET ONE
      JIN=7
      JOUT=7
100   CONTINUE
      IF (INBUF(JIN:JIN).EQ.QUOTE) THEN
           OUTBUF(JOUT:JOUT)=QUOTE
           OUTBUF(JOUT+1:JOUT+1)=QUOTE
           JOUT=JOUT+2
           JIN=JIN+1
      ELSEIF (INBUF(JIN:MIN(JIN+3,1440)).EQ.SOS) THEN
           OUTBUF(JOUT:JOUT)=QUOTE
           JIN=JIN+10
           JOUT=JOUT+1
      ELSEIF (INBUF(JIN:MIN(JIN+3,1440)).EQ.EOS) THEN
           OUTBUF(JOUT:JOUT)=QUOTE
           JIN=JIN+4
           JOUT=JOUT+1
      ELSE
           OUTBUF(JOUT:JOUT)=INBUF(JIN:JIN)
           JIN=JIN+1
           JOUT=JOUT+1
      ENDIF
C
      IF(JIN.LE.NCHAR) GOTO 100
      NCHAR=JOUT-1
      CALL RMTB(OUTBUF,NCHAR)
      CALL PRBUF(OUTBUF,NCHAR)
      IF(.NOT.EOF) RETURN
      STOP 'DERIER'
      END
        SUBROUTINE FILBUF(INBUF,LINE,NCHAR,EOF)
C       THIS FILLS INBUF WITH THE CHARACTERS IN A FORTRAN STATEMENT
C       INCLUDING CONTINUATION CARDS, BUT NOT INCLUDING THE INITIAL
C       6 COLUMNS OF A CONTINUATION CARD.
C       ON EXIT LINE CONTAINS THE NEXT LINE IF THERE WAS ONE,
C       EOF IS TRUE IF THERE WAS NO NEXT LINE
        CHARACTER*(*) INBUF,LINE
        INTEGER NCHAR,IN
        CHARACTER*1 BLANK,ZERO
        LOGICAL EOF
        PARAMETER(BLANK=' ',ZERO='0',IN=5)
      EOF=.FALSE.
C
        INBUF(1:72)=LINE
        NCHAR=72
100     READ(IN,'(A72)',END=200) LINE
        IF( (LINE(6:6).NE.BLANK) .AND. (LINE(6:6).NE.ZERO) ) THEN
C               FOUND A CONTINUATION CARD
                INBUF(NCHAR+1:NCHAR+66)=LINE(7:72)
                NCHAR=NCHAR+66
                GOTO 100
        ENDIF
        RETURN
200     EOF=.TRUE.
        RETURN
        END
        SUBROUTINE PRBUF(OUTBUF,NCHAR)
C       THIS WRITES THE BUFFER TO THE OUTPUT FILE USING CONTINUATION
C       CARDS AS NECESSARY
        CHARACTER*(*) OUTBUF
        INTEGER NCHAR,NW,NTW,OUT
C       NCHAR IS TOTAL NO OF CHARS, NW IS NUMBER THAT HAVE BEEN WRITTEN
C       AND NTW IS THE NUMBER TO BE WRITEN ON THE NEXT LINE
        CHARACTER*6 CONTIN
        PARAMETER(CONTIN='     %')
        PARAMETER(OUT=6)
C
        IF(NCHAR.LE.72) THEN
                WRITE(OUT,'(A)') OUTBUF(1:NCHAR)
                RETURN
        ENDIF
C
        WRITE(OUT,'(A72)') OUTBUF(1:72)
        NW=72
100     NTW=MIN( (NCHAR-NW),66)
        WRITE(OUT,'(A6,A)') CONTIN,OUTBUF(NW+1:NW+NTW)
        NW=NW+NTW
        IF(NW.LT.NCHAR) GOTO 100
        RETURN
        END
      SUBROUTINE RMTB(OUTBUF,NCHAR)
C     REMOVE TRAILING BLANKS FROM OUTBUF
      INTEGER NCHAR
      CHARACTER*(*) OUTBUF
      CHARACTER*1 BLANK
      PARAMETER(BLANK=' ')
100   IF( OUTBUF(NCHAR:NCHAR) .NE. BLANK) RETURN
      NCHAR=NCHAR-1
      GOTO 100
      END
