program ggcastep
      implicit none
      integer il,ic,aa,nat
      real a(3),b(3),c(3)
      real,allocatable::r(:)
      integer,allocatable::q(:)
      character*80 fn,s80
      call getarg(1,fn)
      open(9,file=fn,status='old')
      il=0
      ic=0
      aa=0
      nat=0
1     read(9,90,end=99,err=99)s80
90    format(a80)
      il=il+1

      if(s80(39:47).eq.'Unit Cell')then
       write(6,*)il,s80(39:47)
       ic=ic+1
       read(9,*)
       read(9,*)
       read(9,*)a
       read(9,*)b
       read(9,*)c
       write(6,*)'Unit cell'
      endif

      if(s80(38:50).eq.'Cell Contents')then
       write(6,*)il,s80(38:50)
       aa=aa+1
       read(9,*)
       read(9,90)s80

       if(s80(26:30).eq.'Total')then
        read(s80(56:60),*)nat
        if(aa.eq.1)then
         allocate(r(3*nat),q(nat))
         open(10,file='FILE.X')
        endif
        call rrx(7,nat,r,q)
       else
        call rrx(4,nat,r,q)
       endif
       call wrx(10,aa,nat,a,b,c,r,q)
      endif

      goto 1
99    close(9)
      write(6,*)il,' lines'
      write(6,*)aa,' geometries'
      write(6,*)nat,' atoms'
      if(aa.gt.0)close(10)
      end

      subroutine rrx(i7,nat,r,q)
      implicit none
      integer i7,i,nat,q(*),symboltoatnumber,ix
      character*2 sy
      real r(*)
      do 2 i=1,i7
2     read(9,*)
      do 3 i=1,nat
      if(i7.eq.7)read(9,901)sy,(r(ix+3*(i-1)),ix=1,3)
901   format(14x,A2,19x,3f11.6)
      if(i7.eq.4)read(9,902)sy,(r(ix+3*(i-1)),ix=1,3)
902   format(14x,A2,24x,3f11.6)
3     q(i)=symboltoatnumber(sy)
      return
      end

      subroutine wrx(io,aa,nat,a,b,c,r,q)
      implicit none
      integer i,io,aa,nat,q(*)
      real a(*),b(*),c(*),r(*),x,y,z
      write(io,*)'CSTEP geometry ',aa
      write(io,*)nat
      do 1 i=1,nat
      x=a(1)*r(1+3*(i-1))+b(1)*r(2+3*(i-1))+c(1)*r(3+3*(i-1))
      y=a(2)*r(1+3*(i-1))+b(2)*r(2+3*(i-1))+c(2)*r(3+3*(i-1))
      z=a(3)*r(1+3*(i-1))+b(3)*r(2+3*(i-1))+c(3)*r(3+3*(i-1))
1     write(io,100)q(i),x,y,z
100   format(i5,3f12.6,' 0 0 0 0 0 0 0 0.0')
      return
      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.'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