program msg
c
c     makes script for roa differentiation with gaussian
      implicit integer*4(i-n)
      implicit real*8 (a-h,o-z)
      parameter (nat0=1000)
      character*80 if,s80,of,af,h,n,sy
      character*1 s1
      character*2 s2
      dimension r(nat0,3),h(30),n(nat0),sy(nat0),rr(3)
c
      write(6,*)'.inp input file (WITH the .inp extension):'
      read(5,'(a)')if
      open(2,file=if)
c
c     read header
      ih=0
1     read(2,200,end=888,err=999)s80
200   format(a80)
      if(s80.ne.'')then
       ih=ih+1
       h(ih)=s80
       goto 1
      endif
      do 2 i=1,ih
2     write(6,200)h(i)
      write(6,*)
c
c     read name
      in=0
3     read(2,200,end=888,err=999)s80
      if(s80.ne.'')then
       in=in+1
       n(in)=s80
       goto 3
      endif
      do 4 i=1,in
4     write(6,200)n(i)
      write(6,*)
c
c     charge and multiplicity
      read(2,*,end=888,err=999)icha,imu
c    
c     atoms
      ia=0
51    read(2,200,end=888,err=999)s80
      if(s80.ne.'')then
       ia=ia+1
c
c      where starts and ends a symbol:
       is=0
5      is=is+1       
       if(is.gt.80)goto 999
       if(s80(is:is).eq.' ')goto 5
       ie=is
6      ie=ie+1       
       if(ie.gt.80)goto 999
       if(s80(ie:ie).ne.' ')goto 5
       ie=ie-1
       open(4,file='scr')
       write(4,200)s80(ie+1:80)
       rewind 4
       read(4,*)(r(ia,ii),ii=1,3) 
       close(4)
       sy(ia)='  '
       sy(ia)(1:1)=s80(is:is)
       if(ie.gt.is)sy(ia)(2:2)=s80(ie:ie)
       goto 51
      endif
      nat=ia
      write(6,*)nat,' atoms'
      close(2)
c
      write(6,*)'Step of the differentiation (A):'
      read(5,*)step
      write(6,*)'1 or 2 step differentiation (1/2) ?'
      read(5,*)ic
      write(6,*)3*nat*ic+1,' points'
      open(4,file='NAT')
      write(4,*)nat
      write(4,*)step
      write(4,*)ic
      write(4,*)3*nat*ic+1
      close(4)
c
c     gaussian job:
      open(5,file='DSG')
c
c     roa job:
      open(7,file='DSR')
      write(7,*)'rm *.SCR'
      open(4,file='scr')
      ii=-1
      do 39 i2=1,ic
      do 39 iat=1,nat
      iaxstart=1
      if(i2.eq.1.and.iat.eq.1)iaxstart=0
      do 39 iax=iaxstart,3
      ii=ii+1
      rewind 4
      write(4,40)ii
40    format(i4)
      rewind 4
      read(4,41)of(1:4)
41    format(a4)
      of(5:8)='.inp'
      write(5,50)of(1:8)
      write(5,*)'echo ',ii,' > LOG'
50    format('cp',a20,' tem.inp')
      write(5,*)'g98 tem.inp tem.out'
      write(5,*)'chopg'
      if(ii.gt.999)iu=1
      if(ii.le.999.and.ii.gt.99)iu=2
      if(ii.le.99.and.ii.gt.9)iu=3
      if(ii.le.9)iu=4
      write(5,52)of(iu:4)
52    format('cp MOS.SCR ',a4,'MOS.Scr')
      open(3,file=of(iu:8))
      write(7,600)of(iu:4)
600   format('cp ',a4,'.GOT SP')
      write(7,602)of(iu:4)
602   format('cp ',a4,'MOS.Scr MOS.SCR')
c
      write(7,*)'roa > OUT'
      write(7,601)of(iu:4),of(iu:4),of(iu:4),of(iu:4),of(iu:4)
601   format('cp A.TEN ',a4,'A.TEN',/,'cp G.TEN ',a4,'G.TEN',/,
     1       'cp AL.TEN ',a4,'AL.TEN',/,'cp ALV.TEN ',a4,'ALV.TEN',/,
     1       'cp GEO.X ',a4,'.X')
      write(7,*)'rm -f *.SCR'
      write(7,*)'echo ',of(iu:4),' > LOG2'
c
      do 49 i=1,ih
49    write(3,200)h(i)
      write(3,*)
      do 59 i=1,in
59    write(3,200)n(i)
      write(3,*)
      write(3,2000)icha,imu
2000  format(2i4)
      do 69 ia=1,nat
      do 691 ix=1,3
691   rr(ix)=r(ia,ix)
      if(ia.eq.iat.and.iax.gt.0)then
       if(i2.eq.1)rr(iax)=rr(iax)+step
       if(i2.eq.2)rr(iax)=rr(iax)-step
      endif
69    write(3,300)sy(ia),(rr(ix),ix=1,3)
300   format(a2,1x,3f20.15)
      write(3,*)
      close(3)
39    continue
      write(5,*)'echo finished > LOG'
      close(4)
      close(5)
      close(7)
      write(6,*)'files DSG and DSR created'
      goto 777
888   write(6,*)'end of file'
999   write(6,*)'error stop'
777   stop
      end