program setc
      parameter (nat0=500)
      character*80 fn
      dimension r(nat0,3),it(nat0),rc(nat0,3),q(nat0)
      qo=-1.04
      qh= 0.52
      write(6,*)'.X file name: '
      read(5,500)fn
500   format(a80)
      open(7,file=fn)
      read(7,*)
      read(7,*)nat
      do 1 ia=1,nat
1     read(7,*)it(ia),(r(ia,ix),ix=1,3)
      close(7)
      open(7,file='FRES.INP')
      open(71,file='G98.INP')
      write(7,700)fn
      write(71,7001)fn
700   format('#bpw91/6-31G nosymm freq iop(2/11=1) ',/,
     1'Geom=(NoDIstance,NoAngle)',/,/,a80,/,/,'0 1')
7001  format('%chk=xx.chk',/,
     1'#bpw91/6-31G** nosymm charge force  iop(2/11=1) ',/,
     1'Geom=(NoDIstance,NoAngle)',/,/,a80,/,/,'0 1')
      nc=0
      do 2 ia=1,nat
      x=r(ia,1)
      y=r(ia,2)
      z=r(ia,3)
      ic=0
      if(it(ia).eq.8)then
       do 3 ja=1,nat
       d=(x-r(ja,1))**2+(y-r(ja,2))**2+(z-r(ja,3))**2
3      if(d.lt.1.5.and.it(ja).eq.1)ic=ic+1
      endif
      if(it(ia).eq.1)then
       do 4 ja=1,nat
       d=(x-r(ja,1))**2+(y-r(ja,2))**2+(z-r(ja,3))**2
4      if(d.lt.1.5.and.it(ja).eq.8)ic=ic+1000
      endif
      if(ic.gt.0)then
       nc=nc+1
       if(ic.eq.2)q(nc)=qo
       if(ic.eq.1000)q(nc)=qh
       rc(nc,1)=r(ia,1)
       rc(nc,2)=r(ia,2)
       rc(nc,3)=r(ia,3)
      else
       write(7,701)it(ia),(r(ia,ix),ix=1,3)
       write(71,701)it(ia),(r(ia,ix),ix=1,3)
701    format(i5,3f12.6)
      endif
2     continue
      write(7,*)
      write(71,*)
      do 5 ic=1,nc
5     write(71,702)(rc(ic,ix),ix=1,3),q(ic)
702   format(4f12.6)
      write(7,*)
      write(71,*)
      close(7) 
      close(71) 
      write(6,6000)nat,nc,nat-nc
6000  format(i5,' atoms, ',i5,' charges, ',i5,' solute atoms')
      stop
      end