C 
C Program 'CLEAN' to modify lines with a given character in the first
C column.
C
C Date: 1998, September 20
C Coded by Ludek Klimes
C
C.......................................................................
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.......................................................................
C
C                                                    
C Description of the data files:
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'..Characters in the first 2 columns of some lines of
C             'FOLD' to be replaced.
C     'CNEW'..New pair of characters replacing 'COLD'.  If 'CNEW'='- ',
C             the whole line is deleted.
C     /...    An obligatory slash for the sake of compatibility with
C             future extensions.
C
C-----------------------------------------------------------------------
C
      CHARACTER*80 FOLD,FNEW
      CHARACTER*2  COLD,CNEW
      CHARACTER*72 LINE
      INTEGER IERR,I,J,K
C
      WRITE(*,'(2A)') '+Enter old and new filenames, ',
     *                'and old and new strings in the first 2 columns: '
      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
C       CLEAN-01
        CALL ERROR
     *          ('CLEAN-01: Input FORTRAN77 source file does not exist')
      END IF
C-    OPEN(2,FILE=FNEW,STATUS='NEW',IOSTAT=IERR)
C-    IF(IERR.NE.0) THEN
C-      CLEAN-02
C-      CALL ERROR
C-   *         ('CLEAN-02: Output FORTRAN77 source file already exists')
C-    END IF
      OPEN(2,FILE=FNEW)
C
C     Loop for the lines in the input source file
      WRITE(*,'(2A)') '+Editing ',FNEW(1:70)
   20 CONTINUE
C
C       Reading a line:
        READ(1,'(A)',END=90) LINE
C
C       Copying a line:
        IF(LINE(1:2).EQ.COLD) THEN
          LINE(1:2)=CNEW
        END IF
        IF(LINE(1:2).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:
          WRITE(*,'(2A)') '+Warning: Empty line in ',FOLD(1:56)
          WRITE(*,'(A)') ' '
        END IF
C
      GO TO 20
C     End of loop for the lines in the input source file
C
   90 CONTINUE
      WRITE(*,'(2A)') '+Done:    ',FNEW(1:70)
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
C
C=======================================================================
C