C PROGRAM 'CLEAN' TO MODIFY LINES WITH A GIVEN CHARACTER IN THE FIRST
C COLUMN.
C
C THIS PROGRAM IS DESIGNED TO EDIT FORTRAN77 SOURCE CODE FILES
C CONTAINING OTHER CHARACTERS THAN 'C' OR '*' IN THE FIRST COLUMN.  SUCH
C SOURCE FILES MAY BE CREATED WITH THE INTENTION OF A CONDITIONED
C COMPILATION NOT ENABLED BY THE FORTRAN77 STANDARD.
C
C MAIN INPUT DATA FILE READ FROM THE * EXTERNAL UNIT:
C     ONE LINE CONTAINING CHARACTER STRINGS, READ BY MEANS OF THE LIST
C     DIRECTED INPUT (FREE FORMAT):
C (1) 'FOLD','FNEW','COLD','CNEW',/
C     'FOLD'..NAME OF THE INPUT FILE.
C     'FNEW'..NAME OF THE OUTPUT FILE.
C     'COLD'..CHARACTER IN THE FIRST COLUMN OF SOME LINES OF 'FOLD' TO
C             BE REPLACED.
C     'CNEW'..NEW CHARACTER REPLACING 'COLD'.  IF 'CNEW'='-', THE WHOLE
C             LINE IS DELETED.
C     /...    AN OBLIGATORY SLASH FOR THE SAKE OF COMPATIBILITY WITH
C             FUTURE EXTENSIONS.
C
C DATE: 1994, JANUARY 3
C CODED BY LUDEK KLIMES
C
C-----------------------------------------------------------------------
C
      CHARACTER*80 FOLD,FNEW
      CHARACTER*1  COLD,CNEW
      CHARACTER*72 LINE
      INTEGER IERR,I,J,K
C
      WRITE(*,'(2A)') '+ENTER OLD AND NEW FILENAMES, ',
     *                'AND OLD AND NEW CHARACTERS IN THE FIRST COLUMN: '
      READ(*,*) FOLD,FNEW,COLD,CNEW
C
C     OPENING THE INPUT AND OUTPUT FORTRAN77 SOURCE CODE FILES:
      WRITE(*,'(2A)') '+OPENING OLD (INPUT) AND NEW (OUTPUT) FILES.',
     *                '                                   '
      OPEN(1,FILE=FOLD,STATUS='OLD',IOSTAT=IERR)
      IF(IERR.NE.0) THEN
        PAUSE 'ERROR: INPUT FORTRAN77 SOURCE FILE DOES NOT EXIST'
        STOP
      END IF
      OPEN(2,FILE=FNEW,STATUS='NEW',IOSTAT=IERR)
      IF(IERR.NE.0) THEN
        PAUSE 'ERROR: OUTPUT FORTRAN77 SOURCE FILE ALREADY EXISTS'
        STOP
      END IF
C
C     LOOP FOR THE LINES IN THE INPUT SOURCE FILE
      WRITE(*,'(A)') '+EDITTING.                                       '
   20 CONTINUE
C
C       READING A LINE:
        READ(1,'(A)',END=90) LINE
C
C       COPYING A LINE:
        IF(LINE(1:1).EQ.COLD) THEN
          LINE(1:1)=CNEW
        END IF
        IF(LINE(1:1).NE.'-') THEN
          DO 33 K=72,12,-12
            IF(LINE(K-11:K).NE.' ') THEN
              DO 32 J=K,K-9,-3
                IF(LINE(J-2:J).NE.' ') THEN
                  DO 31 I=J,J-2,-1
                    IF(LINE(I:I).NE.' ') THEN
                      WRITE(2,'(A)') LINE(1:I)
                      GO TO 20
                    END IF
   31             CONTINUE
                END IF
   32         CONTINUE
            END IF
   33     CONTINUE
C         EMPTY LINE:
          PAUSE 'WARNING: EMPTY LINE ENCOUNTERED'
        END IF
C
      GO TO 20
C     END OF LOOP FOR THE LINES IN THE INPUT SOURCE FILE
C
   90 CONTINUE
      WRITE(*,'(A)') '+END.                                            '
      STOP
      END
C
C=======================================================================
C