C
C     This code is distributed under the terms and conditions of the
C     CCP4 licence agreement as `Part ii)' software.  See the conditions
C     in the CCP4 manual for a copyright statement.
C
c ......................................................................
      program bones2pdb
c bones2pdb: convert bones output to pdb file.
c  ideal for making a mask in Dr Cowtan's excellent ncsmask program :-)
c  By Dr K.D. Cowtan 20/1/95
c  I wonder if writing comments in a little program like this counts
c  as talking to yourself - fat chance anyone'll ever read it. Bit like
c  their 'dm' output.
c      implicit none
c
      integer ibeg(40),iend(40),itype(40),idec(40),ntok,ifail
      real fvalue(40)
      character*4 cvalue(40)
      logical lend
c
      integer i,natom,ibones,ixyzout,iresn
      real b(6),biso,cell(6),occ,x,y,z
      character line*132,xfmt*132,key*4,resnam*4,atnam*4,id*4,inscod*1,
     +          altcod*1,segid*4,resno*4,chnnam*1
c
      external ccpdpn,ccperr,ccpfyp,ccprcs,parse,parser,rdcell,
     +         WBCELL,XYZADVANCE,XYZATOM,XYZCLOSE,
     +         XYZCOORD,XYZINIT,XYZOPEN
c
      call ccpfyp()
      call ccprcs (6, 'BONES2PDB', '$Date: 1997/11/21 12:22:18 $')
      call XYZINIT
c
      cell(1)=0.0
      cell(2)=0.0
      cell(3)=0.0
      cell(4)=90.0
      cell(5)=90.0
      cell(6)=90.0
      atnam = 'C   '
      resnam = 'BON '
      chnnam = ' '
      iresn = 1
      resno = ' '
      inscod = ' '
      altcod = ' '
      segid = ' '
      id = ' C  '
      occ = 1.0
      b(1) = 20.0
      biso = 0
      do 15 i=2,6
        b(i) = 0.0
 15   continue
c
      write (*,20)
 20   format(
     +  /,' Files:'
     +  /,'   BONESIN filename XYZOUT filename'
     +  /,' Keywords: (CELL compulsory)'
     +  /,'   CELL a b c [alpha beta gamma]',/,'   END')
c
 40    line = '   '
       key = ' '
       ntok = 40
       call parser(key,line,ibeg,iend,itype,fvalue,cvalue,idec,ntok,
     +   lend,.true.)
c
       if (key.eq.'CELL') then
         call rdcell(2,itype,fvalue,ntok,cell)
       endif
      if (key.ne.'END '.and..not.lend) goto 40
c
      if (cell(1).le.0.0) call ccperr(1,' missing CELL card')
c
c READ IN A BONES FILE --------------------------------------------------
c and write a PDB file
c
      i=0
      ifail=0
      ibones = 0
      ixyzout = 0
      call ccpdpn(ibones,'BONESIN','READONLY','F',i,ifail)
      ifail=0
      call XYZOPEN('XYZOUT','OUTPUT',' ',IXYZOUT,ifail)
c
c write pdb header
      call WBCELL(IXYZOUT,cell,1)
c
c find beginning of coord list
 60   read (ibones,91)line
      if (line(1:14).ne.'BONES_ATOM_XYZ' .and. 
     +    line(1:13).ne.'BONE_ATOM_XYZ' .and.
     +    line(1:14).ne.'SKEL_ATOM_XYZ ') goto 60
c
      ntok=-40
      call parse(line,ibeg,iend,itype,fvalue,cvalue,idec,ntok)
      natom=nint(fvalue(3))/3
      xfmt=line(ibeg(4):iend(4))
c
      do 80 i=1,natom
       read (ibones,xfmt,err=901)x,y,z

       call XYZATOM(IXYZOUT,i,atnam,resnam,chnnam,iresn,resno,
     +                 inscod,altcod,segid,iz,id)
       call XYZCOORD(IXYZOUT,'O','U',x,y,z,occ,biso,b)
       call XYZADVANCE(IXYZOUT,0,0,*80,*80)
 80   continue
c
 91   format(a)
      close (unit=ibones,status='KEEP')
      call XYZCLOSE (IXYZOUT)
c
      write (*,101)natom
 101  format(' Number of atoms written = ',i7)
      call ccperr(0, 'Normal termination')
 901  call ccperr(1,' Error reading bones file')
      end
c
c ----------------------------------------------------------------------
c