program prepq
      parameter (nat0=2000)
      integer*4 nf,i,ij
      character*80 gn
      logical*4 lex
      dimension ij(2000)
c
      write(6,*)'QGRAD optimization preparation'
      write(6,*)'Number of fragments:'
      read(5,*)nf
      write(6,*)'Generic name:'
      read(5,5000)gn
5000  format(a80)
      do 2 n1=1,len(gn)
2     if(gn(n1:n1).ne.' ')goto 3
3     do 4 n2=len(gn),1,-1
4     if(gn(n2:n2).ne.' ')goto 5
5     inquire(file='goprep',exist=lex)

      if(lex)then

      write(6,*)'goprep exists'

      else

      open(4,file='goprep')
      do 6 i=1,nf
      il=int(log(dble(i))/log(10.0d0))+1
      ir=i
      do 8 ii=1,il
      jj=ir/10**(il-ii)
      gn(n2+ii:n2+ii)=char(48+jj)
8     ir=ir-jj*10**(il-ii)
      write(4,4001)'mkdir '//gn(n2+1:n2+il)
4001  format(80a)
      write(4,4001)'cp '//gn(n1:n2+il)//'.inp  '
     1//gn(n2+1:n2+il)//'/G98.INP'
      write(4,4001)'cp '//gn(n1:n2+il)//'.fres '
     1//gn(n2+1:n2+il)//'/FRES.INP'
      write(4,4001)'cp free.inp '//gn(n2+1:n2+il)//'/FREE.INP'
      write(4,4001)'cp go '//gn(n2+1:n2+il)
      write(4,4001)'cp Q.OPT '//gn(n2+1:n2+il)
      write(4,4001)'cd '//gn(n2+1:n2+il)
      write(4,4001)'./go'
      write(4,4001)'cd ..'
      write(4,4001)'cp '//gn(n2+1:n2+il)//'/TEN '
     1//gn(n1:n2+il)//'.ten'
      write(4,4001)'cp '//gn(n2+1:n2+il)//'/FC '
     1//gn(n1:n2+il)//'.fc'
      write(4,4001)'cp '//gn(n2+1:n2+il)//'/X '
     1//gn(n1:n2+il)//'.x'
6     continue
      write(4,4001)'cctn'
      close(4)
      write(6,*)'goprep created'

      endif
c 
      inquire(file='go',exist=lex)
      if(.not.lex)then
       open(4,file='go')
       write(4,4002)
4002   format('g98 FRES.INP FRES.OUT',/,'g98 G98.INP G98.OUT',/,
     1 'echo AUTO > AUTO',/,'gg',/,'cp FILE.X geos.x',/,
     2 'cp FRES.OUT FRE.OUT',/,'gar',/,'new1',/,'new2',/,
     3 'qgrad',/,'cp INP.NEW G98.INP',/,'runopt',/,'gg',/,
     4 'cp FILE.X X',/,'g98 FREE.INP FREE.OUT',/,
     5 'cp FREE.OUT FRE.OUT',/,'gar',/,'cp FILE.FC FC',/,
     6 'cp FILE.TEN TEN',/,'rm *.rwf Gau*')
       close(4)
       write(6,*)'go created'
      else
       write(6,*)'go exists'
      endif
c
      inquire(file='Q.OPT',exist=lex)
      if(.not.lex)then
       open(4,file='Q.OPT')
       write(4,4003)
4003   format('wmax',/,'300.0',/,
     1        'wmin',/,'-300.0',/,
     2        'glimit',/,'0.001',/,
     2        'qmax',/,'0.2')
       close(4)
       write(6,*)'Q.OPT created'
      else
       write(6,*)'Q.OPT exists'
      endif
c
      inquire(file='CCT.INP',exist=lex)
      if(lex)then
       write(6,*)'CCT.INP exists'
      else
       open(4,file='CCT.INP')
       write(4,4004)nf
4004   format('LNAMES',/,'t',/,'LWR',/,'t',/,'LABS',/,'t',/,
     1 'LROA',/,'f',/,'LVCD',/,'t',/,'LDIA',/,'t',/,'LOFF',/,
     2 't',/,'IWG',/,'0',/,'LSTRICT',/,'f',/,'CUTOFF',/,'20.0',/,
     3 'LHALTONERROR',/,'f',/,'POLYMER',/,i4)
       do 9 i=1,nf
       write(4,4006)i
4006   format(i4)
       il=int(log(dble(i))/log(10.0d0))+1
       ir=i
       do 81 ii=1,il
       jj=ir/10**(il-ii)
       gn(n2+ii:n2+ii)=char(48+jj)
81     ir=ir-jj*10**(il-ii)
       write(4,4001)gn(n1:n2+il)
       inquire(file=gn(n1:n2+il)//'.cct',exist=lex)
       if(lex)then
        open(41,file=gn(n1:n2+il)//'.cct')
        read(41,*)nat
        if(nat.gt.nat0)then
         write(6,*)'too many atoms'
         stop
        endif
        read(41,*)
        read(41,4005)(ij(j),j=1,nat)
        write(4,4005)(ij(j),j=1,nat)
4005    format(20i3)
        read(41,4005)(ij(j),j=1,nat)
        write(4,4005)(ij(j),j=1,nat)
        close(41)
       endif
9      continue
       close(4)
       write(6,*)'CCT.INP created'
      endif
c
      stop
      end