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