     	PROGRAM SUBSAS
C
C  PROGRAMMER:  R.S. ZHOU
C		ALFRED UNIVERSITY, OCT. 1987
C
C	THIS ROUTINE SUBSTITUTES A CHARACTER STRING IN ASCII FILES.
C
C	AN INPUT FILE, WHICH CONTAINS A LIST OF THE NAMES OF THE FILES 
C	TO BE SEARCHED FOR, SUBSTITUTING AND SUBSTITUTED ASCII STRINGS
C	ARE SOLICITED INTERACTIVELY IN RUN TIME.
C
     	CHARACTER FNAME*32, TEXT*132, LINE*132, SUBO*132, SUBI*132
C
C  GET THE FILE LISTING FILE FIRST...
C
1	WRITE(6,1000)
1000	FORMAT('$File listing filename: ')
     	READ(5,1001,ERR=999,END=999) FNAME
1001	FORMAT(A)
     	IF( FNAME.EQ.' ' ) GOTO 1

     	OPEN( UNIT=1, FILE=FNAME, STATUS='OLD', ERR=111,
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', READONLY )
     	GOTO 100

111	WRITE(6,112)
112	FORMAT(' ERROR: can not open the listing file.')
     	CLOSE(UNIT=1)
     	GOTO 1
C
C  GET THE SUBSTITUTED ASCII STRING NEXT...
C
100	WRITE(6,2000)
2000	FORMAT('$Enter the string to be substituted: ')
     	READ(5,1001,ERR=999,END=999) SUBO
     	IF( SUBO.EQ.' ' ) GOTO 100
     	NSO = NALPHA( SUBO, 132 )
C
C  GET THE SUBSTITUTING ASCII STRING NEXT...
C
200	WRITE(6,2100)
2100	FORMAT('$Enter the string to substitute: ')
     	READ(5,1001,ERR=999,END=999) SUBI
     	NSI = NALPHA( SUBI, 132 )
C
C  START THE SUBSTITUTIONS...
C
333	READ(1,1001,ERR=999,END=999) FNAME

     	IF( FNAME.EQ.' ' ) GOTO 333
     	OPEN( UNIT=13, FILE=FNAME, STATUS='OLD', ERR=777,
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED', READONLY )
     	OPEN( UNIT=14, FILE=FNAME, STATUS='NEW', ERR=777,
     	1 CARRIAGECONTROL='LIST', FORM='FORMATTED' )

     	NCH = NALPHA( FNAME, 32 )
     	WRITE(6,444) FNAME(1:NCH)
444	FORMAT(/' <*> ',A<NCH>,':')

555	READ(13,1001,ERR=888,END=888) TEXT
     	IF( TEXT.NE.' ' ) THEN
     	    NCH = NALPHA( TEXT, 132 )
     	    IQS = INDEX( TEXT(1:NCH), SUBO(1:NSO) )
     	    IF( IQS.GT.0 ) THEN
     		WRITE(6,667) TEXT(1:NCH)
     		LINE(      1:IQS-1 ) = TEXT(      1:IQS-1)
     		LINE(    IQS:      ) = SUBI(      1:NSI  )
     		LINE(IQS+NSI:      ) = TEXT(IQS+NSO:     )
     		NCH = NCH + (NSI-NSO)
     		WRITE(14,666,ERR=777) LINE(1:NCH)
     	    ELSE
     		WRITE(14,666,ERR=777) TEXT(1:NCH)
     	    ENDIF
     	ELSE
     	    WRITE(14,1001,ERR=777)
     	ENDIF
     	GOTO 555
666	FORMAT(A<NCH>)
667	FORMAT(X,A<NCH>)

777	WRITE(6,778) FNAME
778	FORMAT(' Can not open file: ',A32)
888	CLOSE(UNIT=13)
     	CLOSE(UNIT=14)
     	GOTO 333

999	CLOSE(UNIT=1)
     	CALL EXIT
     	END

    	FUNCTION NALPHA( TEXT, MAX )
    	CHARACTER TEXT(1)*1
	DO IK = MAX, 1, -1
    	   IF( TEXT(IK).NE.' ' ) GO TO 1
    	ENDDO
	IK = 0
1	NALPHA = IK
    	RETURN
	END
