PROGRAM REDIM
      implicit integer*4 (i-n)
      parameter (n0ln=50000)
      character*180 rs,ns,fn,snext
      character*360 sl(n0ln),ts
      character*1 ok
      dimension nline(n0ln)
      logical lall,lex,lbr
c
      lall=.false.
      write(6,6000)
6000  format('This program substitutes a string in all the',/,
     1       'files listed in REDIM.LST',/,/,
     2' Input the string to be replaced (#^ line break):')
      read(*,'(a)')rs
      do 1 i=180,1,-1
1     if(rs(i:i).ne.' ')goto 2
2     nrs=i
      if(rs(nrs-1:nrs).eq.'#^')then
       lbr=.true.
       nrs=nrs-2
      else
       lbr=.false.
      endif
      write(6,*)' Input the new string (#^ line break at the end):'
      read(*,'(a)')ns
      do 3 i=180,1,-1
3     if(ns(i:i).ne.' ')goto 4
4     nns=i
      iline=0
      do 9 i=1,nns-1
9     if(ns(i:i).eq.'#'.and.ns(i+1:i+1).eq.'^')iline=i
      write(6,*)
      write(6,6001)rs,nrs,ns,nns
6001  format(' Old string:',/,
     1       A80,/,'(',I3,' characters)',/,/,
     2       ' New string:',/,
     3       A80,/,'(',I3,' characters)',/,/,
     4       'Do you want to continue (y/n)?')
      read(*,'(a)')ok
      if(ok.ne.'y'.and.ok.ne.'Y')stop
c
      OPEN(2,FILE='REDIM.LST')
900   READ(2,'(A)',END=999)FN
      write(6,6002)fn
      do 61 i=180,1,-1
61    if(fn(i:i).ne.' ')goto 71
71    nfil=i
6002  format(A180)
c
      ichg=0
      inquire(FILE=FN, exist=lex)
      if(.not.lex)then
       write(6,*)' file does not exist'
       write(6,*)' input any key ...'
       read(*,'(a)')ok
       goto 900
      endif
      OPEN(3,FILE=FN)

      LINE=0
800   LINE=LINE+1
      if(line.gt.n0ln)then
       write(6,*)' Too many lines in ',fn
       close(3)
       stop
      endif
      READ(3,'(a)',END=888)SL(LINE)
      do 6 i=180,1,-1
6     if(sl(line)(i:i).ne.' ')goto 7
7     nline(line)=i
      nlineold=i
      ts=sl(line)
      do 5 i=1,180-nrs+1
      if(sl(line)(i:i+nrs-1).eq.rs(1:nrs))then
       ichg=ichg+1
       write(6,6004)(sl(line)(j:j),j=1,nline(line))
6004   format(180A1)
       if(iline.eq.0)then
        sl(line)(i:i+nns-1)=ns
        nline(line)=nlineold+nns-nrs
        sl(line)(i+nns:nline(line))=ts(i+nrs:nlineold)
        if(lbr)then
c        remove line break
         READ(3,'(a)',END=888)snext
         do 81 i1=180,1,-1
81       if(snext(i1:i1).ne.' ')goto 91
91       nnext=i1
         sl(line)(nline(line)+1:nline(line)+nnext)=snext(1:nnext)
         nline(line)=nline(line)+nnext
        endif
        write(6,6004)(sl(line)(j:j),j=1,nline(line))
        write(6,*)
       else
        sl(line)(i:i+iline-1-1)=ns(1:iline-1)
        nline(line)=i+iline-1-1
        write(6,6004)(sl(line)(j:j),j=1,nline(line))
        line=line+1
        sl(line)(1:nns-iline-1)=ns(iline+2:nns)
        sl(line)(nns-iline-1+1:1+nns-iline-1+nlineold-i-nrs+1)
     1  =ts(i+nrs:nlineold)
        nline(line)=1+nns-iline-1+nlineold-i-nrs+1
        write(6,6004)(sl(line)(j:j),j=1,nline(line))
        write(6,*)
       endif
       goto 800
      endif
5     continue
      goto 800
888   CLOSE(3)
      lint=line-1
      if(ichg.gt.0)then
c
      if(.not.lall)then
      write(6,6003)ichg,lint,(fn(i:i),i=1,nfil),':',(' ',i=1,180-nfil-1)
6003  format(' String found ',I4,'. times;', I5,' lines.',/,/,
     1180A1,/,' Rewrite the file (y/n/a)?')
       read(*,'(a)')ok
       if(ok.eq.'a'.or.ok.eq.'A')then
        ok='y'
        lall=.true.
       endif
       endif
c
       if(lall.or.ok.eq.'y'.or.ok.eq.'Y')then
        OPEN(3,FILE=FN)
        do 8 i=1,lint
8       write(3,6004)(sl(i)(j:j),j=1,nline(i))
        close(3)
        write(6,*)' File was rewritten.'
       endif
      endif
c
      GOTO 900
999   CLOSE(2)
      STOP
      END