C 
C Program 'CREMOVE' to remove comment lines from a Fortran code.
C
C Version: 5.20
C Date: 1997, October 11
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
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','FC',/
C     'FOLD'..Name of the input Fortran file.
C     'FNEW'..Name of the output Fortran file without comment lines.
C     'FC'... Name of the output Fortran file with comment lines only.
C     /...    An obligatory slash for the sake of compatibility with
C             future extensions.
C Default: 'FOLD'=' ', 'FNEW'=' ', 'FC'=' '.
C
C-----------------------------------------------------------------------
C
      CHARACTER*80 FOLD,FNEW,FC
      CHARACTER*72 LINE
      INTEGER ILINE,IERR,I,J,K
C
      WRITE(*,'(2A)') '+Enter 1 input and 1 or 2 output filenames: '
      FOLD=' '
      FNEW=' '
      FC  =' '
      READ(*,*) FOLD,FNEW,FC
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       CREMOVE-01
        CALL ERROR('CREMOVE-01: Input file does not exist')
C       Input FORTRAN77 source file does not exist.
      END IF
      OPEN(2,FILE=FNEW)
      IF(FC.NE.' ') THEN
        OPEN(3,FILE=FC)
      END IF
C
C     Loop for the lines in the input source file
      WRITE(*,'(2A)') '+Editting ',FNEW(1:70)
      ILINE=0
   20 CONTINUE
C
C       Reading a line:
        ILINE=ILINE+1
        READ(1,'(A)',END=90) LINE
C
C       Copying a line:
        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
                    IF(LINE(1:1).EQ.'C'.OR.LINE(1:1).EQ.'c') THEN
                      IF(FC.NE.' ') THEN
                        WRITE(3,'(A)') LINE(1:I)
                      END IF
                    ELSE
                      WRITE(2,'(A)') LINE(1:I)
                    END IF
                    GO TO 20
                  END IF
   31           CONTINUE
              END IF
   32       CONTINUE
          END IF
   33   CONTINUE
C       Empty line:
        WRITE(*,'(A,I5,2A)')
     *                    '+Warning: Empty line',ILINE,' in ',FOLD(1:56)
        WRITE(*,'(A)') ' '
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