C
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 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 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 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 error.for C C======================================================================= C