program makef
      character*80 fn,s80,st
      character*3 sy
      character*1 se
      integer symboltoatnumber
      if(iargc().gt.0)then
       call getarg(1,s80)
       read(s80,*)n1
       call getarg(2,s80)
       read(s80,*)n2
       call getarg(3,s80)
       read(s80,*)nf
       if(iargc().eq.4)call getarg(4,se)
      else
       n1=0
       n2=0
       nf=1
       se='j'
      endif
      ig=0
      ix=0
      open(2,file='STRUCT.LST')
      if(se.eq.'j')open(3,file='FILE.X')
1     read(2,200,end=500,err=500)fn
200   format(a80)
      ig=ig+1

      if((ig.ge.n1).or.n1.eq.0)then
      if((ig.le.n2).or.n2.eq.0)then
      if(mod(ig,nf).eq.0)then
      ix=ix+1

      if(se.ne.'j')then
       write(st,80)ig
80     format(i80)
       do  8 is=1,len(st)
8      if(st(is:is).ne.' ')goto 9
9      open(3,file=st(is:len(st))//'.s.x')      
      endif

      open(4,file=fn)
      read(4,*)nat
      write(3,200)fn
      write(3,*)nat

c     decide if next line box dimension or an atom
      read(4,480)s80
480   format(a80)
      do 3 istart=1,len(s80)
3     if(s80(istart:istart).ne.' ')goto 4
4     do 5 iend=istart+1,len(s80)
5     if(s80(iend:iend).eq.' ')goto 6
6     idec=0
      do 7 i=istart,iend-1
7     if(s80(i:i).eq.'.')idec=idec+1
      if(idec.gt.0)then
c      decimal number first:read next line:
       read(4,400)sy,x,y,z
      else
c      old format, use s80:
       read(s80,400)sy,x,y,z
      endif
      write(3,300)symboltoatnumber(sy),x,y,z

      do 2 ia=2,nat
      read(4,400)sy,x,y,z
400   format(7x,a3,1x,3f12.6)
2     write(3,300)symboltoatnumber(sy),x,y,z
300   format(i3,3f12.6)
      close(4)
      if(se.ne.'j')close(3)

      endif
      endif
      endif

      goto 1
500   close(2)
      if(se.eq.'j')close(3)
      if(se.eq.'j')
     1write(6,*)' FILE.X made,',ig,' geoms.,',ix,' written'
      if(se.ne.'j')
     1write(6,*)ig,' geoms.,',ix,' separate files written'

      stop
      end

      function symboltoatnumber(s)
      implicit none
      character*(*)s
      integer symboltoatnumber,jstart,jend,iend,istart,i
      character*2 atsy(89)
      DATA ATSy/'H ','HE','LI','BE','B ','C ','N ','O ','F ','NE',
     3'NA','MG','AL','SI','P ','S ','CL','AR',
     4'K ','CA','SC','TI','V ','CR','MN','FE','CO','NI','CU','ZN',
     4          'GA','GE','AS','SE','BR','KR',
     5'RB','SR','Y ','ZR','NB','MO','TC','RU','RH','PD','AG','CD',
     5          'IN','SN','SB','TE','I ','XE',
     6'CS','BA','LA',
     6               'CE','PR','ND','PM','SM','EU','GD','TB','DY','HO',
     6               'ER','TM','YB','LU',
     6'HF','TA','W ','RE','OS','IR','PT','AU','HG',
     6          'TL','PB','BI','PO','AT','RN',
     7'FR','RA','AC'/
      jstart=1
      do 1 istart=1,len(s)
1     if(s(istart:istart).ne.' ')goto 2
2     do 3 iend=len(s),1,-1
3     if(s(iend:iend).ne.' ')goto 4
4     do 6 i=istart,iend
6     if(ichar(s(i:i)).gt.96)s(i:i)=char(ichar(s(i:i))-32)

c     capture water and some other idiotic Tinker definitions:
      i=0
      if(s(istart:iend).EQ.'HW')i=1
      if(s(istart:iend).EQ.'H1')i=1
      if(s(istart:iend).EQ.'HC')i=1
      if(s(istart:iend).EQ.'HO')i=1
      if(s(istart:iend).EQ.'OW')i=8
      if(s(istart:iend).EQ.'CA')i=6
      if(s(istart:iend).EQ.'CT')i=6
      if(s(istart:iend).EQ.'CR')i=6
      if(s(istart:iend).EQ.'CS')i=6
      if(s(istart:iend).EQ.'HG')i=1
      if(s(istart:iend).EQ.'K+')i=19
      if(i.ne.0)then
       symboltoatnumber=i
       return
      endif

      do 5 i=1,89
      if(atsy(i)(2:2).eq.' ')then
       jend=1
      else
       jend=2
      endif
      if(atsy(i)(jstart:jend).eq.s(istart:iend))then
       symboltoatnumber=i
       return
      endif
5     continue

c     last resort - consider first letter only:
      i=0
      if(s(istart:istart).eq.'H')i=1
      if(s(istart:istart).eq.'N')i=7
      if(s(istart:istart).eq.'O')i=8
      if(s(istart:istart).eq.'C')i=6
      if(i.ne.0)then
       symboltoatnumber=i
       return
      endif

      write(6,*)s,' symbol not found'
      symboltoatnumber=0
      return
      end