program beatpgi
      write(6,*)
      write(6,*)' Rewriting Gaussian 03 programs '
      write(6,*)' so that it can be compiled with g77'
      write(6,*)
      call rpl('bsd/i386.make','pgf77','g77')
      call rpl('bsd/i386.make','-Minfo',' ')
      call rpl('bsd/i386.make','-Mneginfo','-fno-globals')
      call rpl('bsd/i386.make','-Mreentrant',' ')
      call rpl('bsd/i386.make','-Mrecursive','-Wno-globals')
      call rpl('bsd/i386.make','-Mnosave',
     1'-funsafe-math-optimizations ')
      call rpl('bsd/i386.make','-Munroll','-funroll-loops ')
      call rpl('bsd/i386.make',
     1 '-Mvect=assoc,recog,cachesize:$(CSIZE)$(VECTOR4)',' ')
      call rpl('bsd/i386.make',' -fast ',' -ffast-math ')
      call rpl('bsd/i386.make',' -tp ',' ')
      call rpl('bsd/i386.make',' -mp',' ')
      call rpl('bsd/i386.make','$(MACHTY)',' ')
      call rpl('bsd/i386.make','SYSLIBS = -lm -lc',
     1'SYSLIBS = libpgc.so libpgftnrtl.a -lm -lc ')
      call rpl('bsd/i386.make','$(PC64)',' ')
      call rpl('bsd/i386.make','$(PARMETH)',' ')
      call rpl('utilam.F',' Format(X,',' Format(1X,')
      call rpl('utilam.F',' Format(F16.11,X,',' Format(F16.11,1X,')
      call rpl('utilam.F',' Format(I7,X,A5,',' Format(I7,1X,A5,')
      call rpl('utilam.F',' Format(I6,X)',' Format(I6,1X)')
      call rpl('utilnz.F',' Format(X,',' Format(1X,')
      call rpl('utilnz.F',',A,X,A5)',',A,1X,A5)')
      call rpl('l101.F','NDChMu=Max(MxLONI**2,MxFrag)','NDChMu=MxFrag')
      call rpl('l101.F','NDHvLay=Max(MxLONI,MxFrag)','NDHvLay=MxFrag')
      call rpl('l120.F',' Format(X,',' Format(1X,')
      call rpl('l202.F','NDChMu=Max(MaxLay**2,MxFrag)','NDChMu=MxFrag')
      call rpl('l510.F',',X,I4)',',1X,I4)')
      write(6,600)
600   Format(/,80(1h*),/,' PGI libraries libpgc.so and libpgftnrtl.a ',/,
     1'must be present at the $g03root/g03 directory',/,80(1h*))
      stop
      end
c     ==========================================================
      subroutine rpl(filen,sa,sb)
      implicit integer*4 (i-n)
      parameter (nl0=200000)
c     nl0 ... maximum number of lines
      character*160 buffer(nl0),sl,st
      character*(*) filen,sa,sb
      nl=0
      write(6,*)'Rewriting ',filen
      write(6,*)sa,' -> ',sb
      open(33,file=filen,status='old')
1     read(33,3300,end=9999,err=9999)sl
3300  format(a160)
      nl=nl+1
      if(nl.gt.nl0)then
       write(6,*)filen,' too big, cannot be rewritten'
       close(33)
       stop
      endif
      buffer(nl)=sl
      goto 1
9999  close(33)

      write(6,*)nl,' lines'

      ns=0
      do 2 k=1,nl
      sl=buffer(k)
      do 3 i=1,len(sl)
      n2=i+len(sa)-1
      if (n2.gt.len(sl))goto 2
      if(sl(i:n2).eq.sa)then
       ns=ns+1
       st(n2+1:len(sl))=sl(n2+1:len(sl))
       n3=i+len(sb)-1
       sl(i:n3)=sb
       if(n3.gt.n2)then
        sl(n3+1:len(sl))=st(n2+1:len(sl)+n2-n3)
       else
        sl(n3+1:len(sl)-n2+n3)=st(n2+1:len(sl))
        do 4 j=len(sl)-n2+n3+1,len(sl)
4       sl(j:j)=' '
       endif
       buffer(k)=sl
      endif
3     continue
2     continue

      write(6,*)ns,' substitutions'
      if(ns.eq.0)then
       write(6,*)' File unchanged'
      else
       call wrtb(filen,buffer,nl)
       write(6,*)filen,' changed'
      endif
     
      return
      end
c     ==========================================================
      subroutine wrtb(f,b,n)
      implicit integer*4 (i-n)
      character*160 b(*),ts
      character*(*) f
      open(33,file=f)
      do 1 i=1,n
      ts=b(i)
      do 2 j=len(ts),1,-1
2     if(ts(j:j).ne.' ')goto 3
3     continue
1     write(33,3300)(ts(k:k),k=1,j)
3300  format(160a1)
      close(33)
      return
      end