C                                                            <HTML><PRE>
C Program 'CLEAN' to modify lines with a given character in the first
C column.
C
C Date: 2011, May 19
C Coded by Ludek Klimes
C
C.......................................................................
C
C This program is designed to edit FORTRAN77 source code files
C containing specific characters in the first columns.  Such source
C files may be created with the intention of a conditioned compilation
C not enabled by the FORTRAN77 standard.
C
C This program also cuts the comment lines down to 254 characters, cuts
C the Fortran-code lines down to 72 characters, and removes blank lines.
C
C.......................................................................
C
C                                                    <A NAME="data"></A>
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*264 LINE
      INTEGER IERR,I,J,K,L
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       <A NAME="error01"></A><FONT COLOR="RED">CLEAN-01</FONT>
        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-      <A NAME="error02"></A><FONT COLOR="RED">CLEAN-02</FONT>
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
          IF(LINE(1:1).EQ.'C'.OR.
     *       LINE(1:1).EQ.'c'.OR.LINE(1:1).EQ.'*') THEN
C           Comment line
            IF(LINE(133:264).NE.' ') THEN
              LINE(255:264)=' '
              L=264
            ELSE
              L=132
            END IF
          ELSE
C           Fortran code
            L=72
          END IF
          DO 33 K=L,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     <A HREF="../forms/error.for" TYPE="text/html">error.for</A>
C
C=======================================================================
C                                                                 </PRE>
