program xpdb
      implicit none
      character*80 fx,fp,nm
      integer*4 nat,i,ix,iargc,MENDELEV
      parameter (MENDELEV=89)
      integer*4,allocatable::z(:)
      real*8,allocatable::r(:)
      CHARACTER*2 atsy(MENDELEV),asy
      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'/
      character*1     PDB_altloc
      character*4     PDB_atname
      character*3     PDB_resname
      character*1     PDB_chainID
      integer*4       PDB_residue_sequence_number
      real*4          PDB_occupancy
      real*4          PDB_tempfactor
      character*2     PDB_charge
      character*1     PDB_iCode
      
      if(iargc().ne.2)then
       write(6,*)'usage: xpdb <file.x> <file.pdb>'
       stop
      endif
      call getarg(1,fx)
      call getarg(2,fp)
      open(8,file=fx)
      read(8,80)nm
80    format(a80)
      read(8,*)nat
      allocate(z(nat),r(3*nat))
      do 1 i=1,nat
1     read(8,*)z(i),(r(ix+3*(i-1)),ix=1,3)
      close(8)
      write(6,*)nat,'atoms'

      open(9,file=fp)
      write(9,80)nm
      do 2 i=1,nat
      asy=atsy(z(i))
      PDB_altloc=' '
      PDB_atname(3:4)='  '
      PDB_atname(1:2)=asy
      PDB_resname='XXX'
      PDB_chainID=' '
      PDB_residue_sequence_number=0
      PDB_occupancy=1.0
      PDB_tempfactor=0.0
      PDB_charge=' 0'
      PDB_iCode=' '
2     write(9,90)i,PDB_atname,PDB_altloc,PDB_resname,PDB_chainID,
     1PDB_residue_sequence_number,PDB_iCode,(r(ix+3*(i-1)),ix=1,3),
     2PDB_occupancy,PDB_tempfactor,asy,PDB_charge
90    format('ATOM  ',i5,' ',a4,      a1,         a3,         a1,
     1                         i5,       a1,3x,3f8.3,
     2         f6.2,          f6.2,10x,     a2,a2)
      write(9,81)
81    format('END')
      close(9)
      end